<< Fixed triple space problem in Procedure cpr'xlate >>        <<07425>>00010000
<< David SM Chang    initial fix.    CSY    7/27/83  >>        <<07425>>00015000
$CONTROL   LIST                                                         00020000
$CONTROL   SOURCE                                                       00025000
$CONTROL   WARN                                                         00030000
$CONTROL   MAP                                                          00035000
$CONTROL   CODE                                                         00040000
$CONTROL   LINES= 60                                                    00045000
$CONTROL USLINIT                                                        00050000
$CONTROL SEGMENT= SOFTIO                                                00055000
<<$CONTROL ADDR>>                                                       00060000
$CONTROL MAIN= CIPER    << MPE MODULE 61 -- SOFTIO >>                   00065000
$CONTROL USLINIT                                                        00070000
<<$CONTROL INNERLIST>>                                                  00075000
<<$CONTROL UNCALLABLE>>                                                 00080000
<<$CONTROL SUBPROGRAM>>                                                 00085000
<<$CONTROL PRIVILEGED>>                                                 00090000
$CONTROL ERRORS= 100                                                    00095000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1982. ",            & 00100000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00105000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00110000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00115000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00120000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00125000
                                                                        00130000
$SET X1 = ON                                                            00135000
              << HP3000 cpu type:                            >>         00140000
              <<   ON = HPIB 30/33/40/44/64                  >>         00145000
              <<   OFF = II/III                              >>         00150000
                                                                        00155000
                                                                        00160000
$SET X7 = ON                                                   <<07425>>00165000
              << Special code for internal logging           >>         00170000
              <<   ON = Include code                         >>         00175000
              <<   OFF = Don't include code                  >>         00180000
                                                                        00185000
                                                                        00190000
$SET X9 = OFF                                                  <<04422>>00195000
              << Special code to aid in debugging:           >>         00200000
              <<   ON = Include code                         >>         00205000
              <<   OFF = Don't include code                  >>         00210000
                                                                        00215000
BEGIN                                                                   00220000
                                                                        00225000
COMMENT                                                        <<04434>>00230000
$PAGE "OVERVIEW OF THE SOFTIO MODULE"                          <<04434>>00235000
                                                               <<04434>>00240000
              OVERVIEW OF THE SOFTIO MODULE                    <<04434>>00245000
                                                               <<04434>>00250000
  The SOFTIO module (MPE module 61) is the first phase of the  <<04434>>00255000
CIPER protocol implementation for the HP3000 computer family.  <<04434>>00260000
In addition to SOFTIO, changes have been made to SPOOLING,     <<04434>>00265000
ALLOCATE, and HARDRES to accomodate the new protocol.  Even-   <<04434>>00270000
tually, changes should be made to FILEIO to allow 'hot' users  <<04434>>00275000
the same recovery features now afforded by SPOOLING.           <<04434>>00280000
                                                               <<04434>>00285000
  All of the procedures in SOFTIO execute between the file     <<04434>>00290000
system and the I/O system.  To accomplish this, the ATTACHIO   <<04434>>00295000
procedure in HARDRES has been split into two procedures, one   <<04434>>00300000
still named ATTACHIO, the other P'ATTACHIO.  ATTACHIO is now   <<04434>>00305000
a stub which determines if the device requested is a CIPER     <<04434>>00310000
device, serial disc, or a normal device, and then calls the    <<04434>>00315000
appropriate device handler (e.g. SDISCIO, B08'LOGICAL'DVR, or  <<04434>>00320000
P'ATTACHIO).  P'ATTACHIO (which stands for Physical ATTACHIO)  <<04434>>00325000
contains the bulk of the old ATTACHIO's code.  It performs the <<04434>>00330000
task of getting an IOQ, linking that IOQ to the device's DIT,  <<04434>>00335000
etc.  When SDISCIO and CIPER are ready to do real I/O, they    <<04434>>00340000
call P'ATTACHIO.                                               <<04434>>00345000
                                                               <<04434>>00350000
  B08'LOGICAL'DVR is the entry point into the CIPER subsystem. <<04434>>00355000
All other procedures in SOFTIO perform specialized functions   <<04434>>00360000
for B08'LOGICAL'DVR, and at this time are not called by any    <<04434>>00365000
other modules of MPE.  Procedures which begin with the CPR'    <<04434>>00370000
designator are generic CIPER routines which can be used with   <<04434>>00375000
a logical driver for any future CIPER device.  Procedures      <<04434>>00380000
which begin with a B08' designator have been tailored to       <<04434>>00385000
handle the specific record and status formats of the 2608S     <<04434>>00390000
(which was originally called the 2608B, hence the B08').       <<04434>>00395000
These could be used for other future CIPER devices - the amount<<04434>>00400000
of modification required will depend on how closely those de-  <<04434>>00405000
vices match the 2608S in terms of record formats and command/  <<04434>>00410000
status messages.  As much as was possible in Phase I, the data <<04434>>00415000
structures were designed to be very flexible and upward com-   <<04434>>00420000
patible.                                                       <<04434>>00425000
                                                               <<04434>>00430000
  SOFTIO uses an extra data segment (one per device in Phase I)<<04434>>00435000
to buffer incoming and outgoing data.  Control structures are  <<04434>>00440000
in place to provide multiple devices per data segment, as well <<04434>>00445000
as flexibility on a device by device basis.  A memory manage-  <<04434>>00450000
ment scheme is implemented which allows dynamic allocation of  <<04434>>00455000
regions of the data segment, which provides a way for various  <<04434>>00460000
device handlers and the CIPER levels to obtain memory areas    <<04434>>00465000
independently of other sections.  In the Phase I implementa-   <<04434>>00470000
tion, the CIPER data segment (CDS) gets initialized during the <<04434>>00475000
first request to a given device after the system has been      <<04434>>00480000
started up.  Typically this will be an FOPEN request, but it   <<04434>>00485000
does not have to be.                                           <<04434>>00490000
                                                               <<04434>>00495000
  SOFTIO will move data from user requests (Fwrite, etc.) and  <<04434>>00500000
translate function code, P1, and P2 parameters into device     <<04434>>00505000
escape sequences, and buffer all of that up into what are      <<04434>>00510000
called record buffer areas.  When a buffer area becomes full,  <<04434>>00515000
the record is transmitted to the peripheral following the nor- <<04434>>00520000
mal CIPER protocol.  A user request can span multiple records  <<04434>>00525000
if necessary, and certain requests can cause a record to be    <<04434>>00530000
transmitted even if it contains less than the maximum amount   <<04434>>00535000
of data.  The record size is device dependent, and is estab-   <<04434>>00540000
lished during initialization, when the peripheral reports its  <<04434>>00545000
maximum record size.                                           <<04434>>00550000
                                                               <<04434>>00555000
  The original design called for most of SOFTIO to execute as  <<04434>>00560000
its own process.  There would be a single process for all CIPER<<04434>>00565000
peripherals on a system.  It was tenatively named CIPERIOPROC, <<04434>>00570000
and would be created by INITIAL and awoken by PROGEN, at which <<04434>>00575000
time it would initialize the CDS and link all CIPER peripherals<<04434>>00580000
to a single CDS.  The process would allow better control of the<<04434>>00585000
peripheral, as error conditions could be detected as soon as   <<04434>>00590000
they occurred, rather than later on when (if?) a program       <<04434>>00595000
happened to make a request of the peripheral.  It also meant   <<04434>>00600000
that a caller would not get impeded by SOFTIO if the peripheral<<04434>>00605000
was unable to complete an I/O request.  However, due to several<<04434>>00610000
constraints (shortage of PCB entries and lack of time, to name <<04434>>00615000
just a few) the separate process has not been implemented yet. <<04434>>00620000
As a result, SOFTIO runs on the caller's stack, which has two  <<04434>>00625000
ramifications:  1) the device is only monitored when a calling <<04434>>00630000
request causes a real I/O transaction to take place, and       <<04434>>00635000
2) a larger portion of the available stack is used up, which   <<04434>>00640000
means that programs which were right up against the limit may  <<04434>>00645000
not execute when doing I/O to a 'hot' CIPER device.            <<04434>>00650000
                                                               <<04434>>00655000
  Another important part of the original design which was not  <<04434>>00660000
implemented in Phase I (due to lack of time) is the logical    <<04434>>00665000
IOQ (LIOQ) and communication queue (COMQ) mechanisms.  LIOQs   <<04434>>00670000
are an extension to the IOQ mechanism, similar to the disc     <<04434>>00675000
request table.  The LIOQs would be located in the CIPER data   <<04434>>00680000
segment (so no bank zero memory is needed) and would be re-    <<04434>>00685000
turned to calling programs which had specified no-wait I/O.    <<04434>>00690000
SOFTIO could use these LIOQs without impacting the shortage of <<04434>>00695000
real IOQs.  Certain kernal procedures which manipulate IOQs    <<04434>>00700000
will have to be modified to recognize the LIOQ before they can <<04434>>00705000
be used.  The communication queue mechanism was to be used     <<04434>>00710000
internally by SOFTIO to expand the calling/return parameters   <<04434>>00715000
passed both intra-level and inter-level.  Since most of SOFTIO <<04434>>00720000
executes split-stack, all parameters must be passed by value,  <<04434>>00725000
which reduces the amount of information that can be returned   <<04434>>00730000
by a procedure.  Communication queue elements of variable      <<04434>>00735000
length could be passed back and forth to overcome the 'pass by <<04434>>00740000
value' restrictions.  The procedures which create and mani-    <<04434>>00745000
pulate the LIOQ and COMQ entries have been written, but are    <<04434>>00750000
not called upon by any other procedures yet.                   <<04434>>00755000
                                                               <<04434>>00760000
$PAGE "HOW SOFTIO (CIPER) FITS INTO MPE"                       <<04434>>00765000
           +------------------+      +------------------+      <<04434>>00770000
           | user application |  or  |   CIPERIOPROC    |      <<04434>>00775000
           +------------------+      +------------------+      <<04434>>00780000
                     |                      |                  <<04434>>00785000
                     |  +-------------------+                  <<04434>>00790000
                     |  |                            LDTX      <<04434>>00795000
           +------------------+                    +-------+   <<04434>>00800000
           |   file system    |                    |       |   <<04434>>00805000
           +------------------+             +-----<|       |   <<04434>>00810000
 LEVEL 7             |                      |      |       |   <<04434>>00815000
             +-------+-------+              |      +-------+   <<04434>>00820000
      'cold' |               | 'hot'        |                  <<04434>>00825000
     +--------------+        |              |                  <<04434>>00830000
     |    spooler   |        |              |                  <<04434>>00835000
     +--------------+        |              |                  <<04434>>00840000
             |               |              |         CDS      <<04434>>00845000
             +-------+-------+              |      +-------+   <<04434>>00850000
                     |                      +----->|       |   <<04434>>00855000
           +-------------------+                   |       |   <<04434>>00860000
           |   attachio stub   |                   |       |   <<04434>>00865000
           +-------------------+                   |       |   <<04434>>00870000
                |    |    |                        |       |   <<04434>>00875000
   serial disc  |    |    |  CIPER                 |       |   <<04434>>00880000
       +--------+    |    +----------+             |       |   <<04434>>00885000
       |             |               |             |       |   <<04434>>00890000
+-------------+      |      +----------------+     |       |   <<04434>>00895000
|  sdiscio    |      |      | logical driver |-----|       |   <<04434>>00900000
+-------------+      |      +----------------+     |       |   <<04434>>00905000
       |             |               |             |       |   <<04434>>00910000
------ | ----------- | ------------- | ---------   |       |   <<04434>>00915000
       |             |               |             |       |   <<04434>>00920000
       |             |      +----------------+     |       |   <<04434>>00925000
LEVELS |       other |      |   networking   |     |       |   <<04434>>00930000
 6-5-  |             |      |  levels 3-4-5  |-----|       |   <<04434>>00935000
 4-3   |             |      +----------------+     |       |   <<04434>>00940000
       |             |               |             |       |   <<04434>>00945000
       |             |               |   +---------|       |   <<04434>>00950000
       +--------+    |    +----------+   |         +-------+   <<04434>>00955000
                |    |    |              |                     <<04434>>00960000
           +-------------------+         |            DIT      <<04434>>00965000
           |    p'attachio     |         |         +-------+   <<04434>>00970000
           +-------------------+         |         |       |   <<04434>>00975000
                     |                   | +-------|       |   <<04434>>00980000
-------------------- | ---------------   | |       |       |   <<04434>>00985000
                     |                   | |       +-------+   <<04434>>00990000
 LEVELS 2-1          |                   ^ ^                   <<04434>>00995000
     +-------------+-+-----------+-------------+               <<04434>>01000000
     |             |             |             |               <<04434>>01005000
+---------+   +---------+   +---------+   +---------+          <<04434>>01010000
|   MTS   |   |   MIO   |   |  HP-IB  |   |  other  |          <<04434>>01015000
|  phys.  |   |  phys.  |   |  phys.  |   |  phys.  |          <<04434>>01020000
| driver  |   | driver  |   | driver  |   | drivers |          <<04434>>01025000
+---------+   +---------+   +---------+   +---------+          <<04434>>01030000
$PAGE "ORGANIZATION OF SOFTIO PROCEDURES"                      <<04434>>01035000
                                                               <<04434>>01040000
  The SOFTIO module currently compiles into a single code      <<04434>>01045000
segment, also named SOFTIO.  As the module increases in size   <<04434>>01050000
and complexity, and after the CST expansion is completed, it   <<04434>>01055000
would be a good idea to split the module into two or more code <<04434>>01060000
segments (SOFTIO1, SOFTIO2, etc.).  A recommendation about how <<04434>>01065000
to segment the module will be given later, after a brief de-   <<04434>>01070000
scription about how the module is organized now.               <<04434>>01075000
                                                               <<04434>>01080000
  SOFTIO can be broken into fifteen major groups of pro-       <<04434>>01085000
cedures whose functions are related.  This monologue will de-  <<04434>>01090000
scribe things from the front of the listing to the back, which <<04434>>01095000
is in desending SST number order.  The major groups are:       <<04434>>01100000
                                                               <<04434>>01105000
    1.  Utility procedures                                     <<04434>>01110000
    2.  CDS integrity checking                                 <<04434>>01115000
    3.  CDS memory management                                  <<04434>>01120000
    4.  CDS initialization                                     <<04434>>01125000
    5.  Control Table and Control Block management             <<04434>>01130000
    6.  LIOQ and COMQ management                               <<04434>>01135000
    7.  CIPER Level 4 (transport end-to-end control)           <<04434>>01140000
    8.  CIPER Level 6 (presentation)                           <<04434>>01145000
    9.  Record buffer area allocation/release                  <<04434>>01150000
   10.  Device status processors                               <<04434>>01155000
   11.  Record transmission/reception control                  <<04434>>01160000
   12.  Function code executors                                <<04434>>01165000
   13.  Debugging and analysis tools                           <<04434>>01170000
   14.  Logical driver miscellaneous                           <<04434>>01175000
   15.  CIPER entry point (B08'LOGICAL'DVR)                    <<04434>>01180000
                                                               <<04434>>01185000
Groups 1 through 6 can be used by all levels of CIPER.  Groups <<04434>>01190000
7 and 8 are specific CIPER levels, which are currently imple-  <<04434>>01195000
mented by a single procedure each.  Groups 9 through 15 com-   <<04434>>01200000
prise CIPER Level 7, the logical driver.  Level 7 contains the <<04434>>01205000
largest percentage of code that is tailored for the 2608S.     <<04434>>01210000
The other groups contain the general purpose building blocks   <<04434>>01215000
that can be used to construct a logical driver for nearly any  <<04434>>01220000
future CIPER device.                                           <<04434>>01225000
                                                               <<04434>>01230000
                                                               <<04434>>01235000
                                                               <<04434>>01240000
GROUP 1 -- Utility procedures                                  <<04434>>01245000
                                                               <<04434>>01250000
  This group consists of only two procedures:  B08'ascii and   <<04434>>01255000
Cpr'genmsg.  B08'ascii performs the same function as the ASCII <<04434>>01260000
intrinsic, but can be called split-stack.  Cpr'genmsg is the   <<04434>>01265000
interface to IOMESSAGE, which expects to have DB at SYSDB when <<04434>>01270000
called.                                                        <<04434>>01275000
                                                               <<04434>>01280000
                                                               <<04434>>01285000
                                                               <<04434>>01290000
GROUP 2 -- CDS integrity checking                              <<04434>>01295000
                                                               <<04434>>01300000
  This group consists of five procedures, as outlined below:   <<04434>>01305000
                                                               <<04434>>01310000
Cpr'assertion, Cpr'limit'error, Cpr'coding'error, and          <<04434>>01315000
Cpr'internal'error were originally stubs that called debug.    <<04434>>01320000
At various places in the code, certain integrity and logic     <<04434>>01325000
checks were made.  If any violations were found, one of the    <<04434>>01330000
above four procedures would be called, which then caused DEBUG <<04434>>01335000
to be called so stack and CDS could be examined.  Now the four <<04434>>01340000
procedures call Cpr'shutdown to lock out the device because    <<04434>>01345000
of the integrity error.                                        <<04434>>01350000
                                                               <<04434>>01355000
Cpr'shutdown will mark a bit in the appropriate LDTX entry     <<04434>>01360000
that causes the CIPER ldev to be locked out (all further calls <<04434>>01365000
are rejected) until the system is warmstarted.  A console      <<04434>>01370000
message is issued warning the operator, but unfortunately, no  <<04434>>01375000
message is issued to the calling process (it just gets a bad   <<04434>>01380000
ATTACHIO return).                                              <<04434>>01385000
                                                               <<04434>>01390000
                                                               <<04434>>01395000
                                                               <<04434>>01400000
GROUP 3 -- CDS memory management                               <<04434>>01405000
                                                               <<04434>>01410000
  This group allows an area of the CDS to be allocated and     <<04434>>01415000
optionally initialized to a certain value.  Special preambles  <<04434>>01420000
and postambles are added to allow integrity checking of the    <<04434>>01425000
area.  One of the procedures provides a locking/unlocking      <<04434>>01430000
mechanism for specific types of CDS areas.                     <<04434>>01435000
                                                               <<04434>>01440000
Cpr'get'CDS'area, Cpr'get'2ndary'CDS'area, and Cpr'rel'CDS'area<<04434>>01445000
allow allocation and release of areas of the CDS.  The differ- <<04434>>01450000
ence between a 'normal' area and a 'secondary' area is where   <<04434>>01455000
in the CDS the search for an available space begins.  A secon- <<04434>>01460000
dary area is searched for from the high order address, and is  <<04434>>01465000
typically allocated for a short time only.  Allocating from    <<04434>>01470000
the upper end of the CDS helps prevent fragmentation.  All     <<04434>>01475000
permanent data structures (which most are) are allocated from  <<04434>>01480000
the low end of the CDS.  Cpr'rel'CDS'area does try to recombine<<04434>>01485000
adjacent free areas, but does no other garbage collection at   <<04434>>01490000
this time.                                                     <<04434>>01495000
                                                               <<04434>>01500000
Cpr'lock'CDS'area and Cpr'unlock'CDS'area (same procedure, just<<04434>>01505000
different entry points) provide the hooks for CDS area locking <<04434>>01510000
and unlocking.  This procedure determines the type of area     <<04434>>01515000
from information in the area preamble and performs the appro-  <<04434>>01520000
priate action to lock/unlock the area.  Currently, the only    <<04434>>01525000
lock implemented is for the CTM, which is a pdisable (to lock) <<04434>>01530000
and a penable (to unlock).                                     <<04434>>01535000
                                                               <<04434>>01540000
Cpr'size'of'CDS'area will return the size, in words, of the    <<04434>>01545000
specified area.  The size of the preamble and postamble is not <<04434>>01550000
included in the returned value.                                <<04434>>01555000
                                                               <<04434>>01560000
                                                               <<04434>>01565000
                                                               <<04434>>01570000
GROUP 4 -- CDS initialization                                  <<04434>>01575000
                                                               <<04434>>01580000
  This group of procedures gets called only once per device,   <<04434>>01585000
after the system has been started up.  Their purpose is to     <<04434>>01590000
allocate an extra data segment, initialize the memory manage-  <<04434>>01595000
ment information, set up the skeleton of some of the level     <<04434>>01600000
dependent data structures, and update the appropriate LDTX     <<04434>>01605000
entry to point to the new CDS.  The procedures in this group   <<04434>>01610000
include:                                                       <<04434>>01615000
                                                               <<04434>>01620000
  Cpr'init'sha -- initializes the segment header area (SHA)    <<04434>>01625000
                                                               <<04434>>01630000
  Cpr'init'cntl'of'CDS'area -- initializes the memory manager  <<04434>>01635000
                                                               <<04434>>01640000
  Cpr'init'ctm -- initializes the control table map (CTM)      <<04434>>01645000
                                                               <<04434>>01650000
  Cpr'init'lioq -- initializes the area set aside for LIOQs    <<04434>>01655000
                                                               <<04434>>01660000
  Cpr'init'CDS -- calls the above procedures to initialize.    <<04434>>01665000
                                                               <<04434>>01670000
  Cpr'get'CDS -- allocates an extra data segment for the CDS   <<04434>>01675000
                                                               <<04434>>01680000
  Cpr'get'CTMI -- gets a CTM entry for the current ldev        <<04434>>01685000
                                                               <<04434>>01690000
  Cpr'init'CB -- Builds skeleton of control block for a given  <<04434>>01695000
                 level of a given ldev                         <<04434>>01700000
                                                               <<04434>>01705000
  Cpr'init'CT -- Builds skeleton of control table for a given  <<04434>>01710000
                 ldev                                          <<04434>>01715000
                                                               <<04434>>01720000
  Cpr'cond'chg'ldtx -- updates the appropriate LDTX entry after<<04434>>01725000
                       initialization is complete              <<04434>>01730000
                                                               <<04434>>01735000
  Cpr'init'CDS'for -- calls the above procedures to get a new  <<04434>>01740000
                      CDS built for a given ldev               <<04434>>01745000
                                                               <<04434>>01750000
  Cpr'init'comq -- initializes the communication queue mechan- <<04434>>01755000
                   ism.                                        <<04434>>01760000
                                                               <<04434>>01765000
  Cpr'init'CBI -- allocates and initializes to zero a variable <<04434>>01770000
                  length Control Block Information area (CBI). <<04434>>01775000
                                                               <<04434>>01780000
  Cpr'init'CBIX -- allocates and initializes to zero a variable<<04434>>01785000
                   length Control Block Information area eXten-<<04434>>01790000
                   sion (CBIX).                                <<04434>>01795000
                                                               <<04434>>01800000
  B08'initialize -- determines sizes of all variable length    <<04434>>01805000
                    peripheral status messages and calculates  <<04434>>01810000
                    size of CBIX required.  Allocates and init-<<04434>>01815000
                    ializes the Level 7 CBIX.                  <<04434>>01820000
                                                               <<04434>>01825000
                                                               <<04434>>01830000
                                                               <<04434>>01835000
GROUP 5 -- Control Table (CT) and Control Block (CB) management<<04434>>01840000
                                                               <<04434>>01845000
  This group contains three procedures that manage the access  <<04434>>01850000
to the control tables (one per ldev) and control blocks (one   <<04434>>01855000
per level per ldev).  These procedures insure that only one    <<04434>>01860000
caller is active on a given ldev at one time, and trigger the  <<04434>>01865000
initialization the first time a device is accessed after system<<04434>>01870000
startup.  The procedures are:                                  <<04434>>01875000
                                                               <<04434>>01880000
  Cpr'get'CT'of -- Checks for the presence of a control table  <<04434>>01885000
                   for the specified ldev.  If none exists,    <<04434>>01890000
                   calls the initialization routines.  Performs<<04434>>01895000
                   an integrity check, sets DB to the base of  <<04434>>01900000
                   the CDS, and returns the pointer to the CT. <<04434>>01905000
                                                               <<04434>>01910000
  Cpr'CB'of -- Returns the pointer to the requested control    <<04434>>01915000
               block of a given ldev.                          <<04434>>01920000
                                                               <<04434>>01925000
  Cpr'rel'CT -- Cleans up information in the specified control <<04434>>01930000
                table, returns DB to wherever it was when      <<04434>>01935000
                SOFTIO was called, and gets ready to return to <<04434>>01940000
                the calling user.                              <<04434>>01945000
                                                               <<04434>>01950000
                                                               <<04434>>01955000
                                                               <<04434>>01960000
GROUP 6 -- LIOQ and COMQ management                            <<04434>>01965000
                                                               <<04434>>01970000
  Originally, each level of CIPER/3000 was going to have three <<04434>>01975000
communication queues: request/responce from the level above,   <<04434>>01980000
request/responce to procedures on the same level, and request/ <<04434>>01985000
responce to the next level below.  The LIOQ, which is a special<<04434>>01990000
type of COMQ, was reserved for Level 7 to communicate with     <<04434>>01995000
the file system or spooler.  The sixteen procedures in this    <<04434>>02000000
group have been designed to manage the COMQ mechanism for the  <<04434>>02005000
procedures that wish to use it as a utility.                   <<04434>>02010000
                                                               <<04434>>02015000
  T'link'son'up, T'link'son'side, and T'link'son'down will add <<04434>>02020000
queue elements to a specified comq.  T'delink'son'up,          <<04434>>02025000
T'delink'son'side, and T'delink'son'down will remove queue     <<04434>>02030000
elements from a specified comq.                                <<04434>>02035000
                                                               <<04434>>02040000
  Cpr'get'qh'of retrieves the head element of a specified comq.<<04434>>02045000
The head element is required when adding or deleting a queue   <<04434>>02050000
element to the queue.                                          <<04434>>02055000
                                                               <<04434>>02060000
  Cpr'get'qe and Cpr'rel'qe are responsible for allocating/    <<04434>>02065000
releasing individual queue elements as they are required for   <<04434>>02070000
addition into a particular comq.                               <<04434>>02075000
                                                               <<04434>>02080000
  Cpr'cq'add'son and Cpr'cq'del'son call on the above linking  <<04434>>02085000
routines to add a queue element to a comq.  The comq is a tree <<04434>>02090000
structure where certain relationships are maintained (e.g. a   <<04434>>02095000
single request from a level above could spawn several requests <<04434>>02100000
to a level below).                                             <<04434>>02105000
                                                               <<04434>>02110000
  Cpr'request'transmit, Cpr'request'receive,                   <<04434>>02115000
Cpr'responce'transmit, and Cpr'responce'receive are the four   <<04434>>02120000
procedures of the group that provide the caller's interface to <<04434>>02125000
the comq mechanism.  They are called when a procedure wishes   <<04434>>02130000
to send a message (comq element) to either the level above,    <<04434>>02135000
the level below, or to another procedure on the same level.    <<04434>>02140000
                                                               <<04434>>02145000
                                                               <<04434>>02150000
                                                               <<04434>>02155000
GROUP 7 -- CIPER Level 4 (transport end-to-end control)        <<04434>>02160000
                                                               <<04434>>02165000
  Currently Level 4 exists as the single procedure             <<04434>>02170000
B08'network'protocol.  Its function is to segment Level 7 re-  <<04434>>02175000
cords into one or more packets, the size of which are dependent<<04434>>02180000
upon the type of transport service in use.  For example, the   <<04434>>02185000
Multipoint Terminal System (MTS) can have its associated INP   <<04434>>02190000
interface configured with a variable sized line buffer.  If    <<04434>>02195000
that buffer is smaller than the record size used by the peri-  <<04434>>02200000
pheral, then records must be split apart to accomodate the     <<04434>>02205000
limits of the physical link.  The maximum packet size the      <<04434>>02210000
transport service can accept is reported to Level 4 during     <<04434>>02215000
initialization of the CDS.                                     <<04434>>02220000
                                                               <<04434>>02225000
  Another function of Level 4 is to retransmit packets if nec- <<04434>>02230000
necessary (if the transport service incorrectly transmits one).<<04434>>02235000
Level 4 insures that no packets have been lost and/or dupli-   <<04434>>02240000
cated by checking an incrementing packet number contained in   <<04434>>02245000
a packet header.                                               <<04434>>02250000
                                                               <<04434>>02255000
  If more complex transport services are ever used, such as    <<04434>>02260000
Ethernet, X.25, etc. the Level 4 implementation may become more<<04434>>02265000
complex.  All of the necessary hooks should be in place to     <<04434>>02270000
accomodate a more complex Level 4 protocol.                    <<04434>>02275000
                                                               <<04434>>02280000
                                                               <<04434>>02285000
                                                               <<04434>>02290000
GROUP 8 -- CIPER Level 6 (presentation)                        <<04434>>02295000
                                                               <<04434>>02300000
  Level 6 also consists of a single procedure.  Its purpose is <<04434>>02305000
to translate system request codes (function, P1, and P2) into  <<04434>>02310000
device recognizable escape sequences.  These are merged with   <<04434>>02315000
the caller's data (if any) as that data is moved from the      <<04434>>02320000
caller's stack or extra data segment into a record buffer area <<04434>>02325000
of the CDS.                                                    <<04434>>02330000
                                                               <<04434>>02335000
  The procedure, Cpr'xlate, also attempts to keep the next     <<04434>>02340000
available byte of the record buffer area positioned on a word  <<04434>>02345000
boundary.  This prevents an extra move of the incoming data,   <<04434>>02350000
which would otherwise be required to absorb the odd byte (the  <<04434>>02355000
mfds and mtds instructions only work on word boundaries).      <<04434>>02360000
Cpr'xlate performs this task by padding escape sequences with  <<04434>>02365000
ASCII blanks when possible (some sequences cannot be padded)   <<04434>>02370000
and necessary.                                                 <<04434>>02375000
                                                               <<04434>>02380000
  The original design goals included the option of making      <<04434>>02385000
Cpr'xlate a user callable intrinsic (with perhaps an interface <<04434>>02390000
procedure in-between).  This would provide users with a        <<04434>>02395000
facility to convert function codes into escape sequences for   <<04434>>02400000
use as they saw fit.  As of now, however, Cpr'xlate is only    <<04434>>02405000
used by SOFTIO.                                                <<04434>>02410000
                                                               <<04434>>02415000
                                                               <<04434>>02420000
                                                               <<04434>>02425000
GROUP 9 -- Record buffer area allocation/release               <<04434>>02430000
                                                               <<04434>>02435000
  The logical driver keeps five record buffer areas in the CDS.<<04434>>02440000
One is dedicated to buffering sequential output data, such as  <<04434>>02445000
fwrite and fdevicecontrol calls would pass in.  One is a de-   <<04434>>02450000
dicated input buffer, used to obtain clear-to-send indications <<04434>>02455000
and other status reports from the peripheral.  The other three <<04434>>02460000
record buffer areas are kept in a linked free-list.  A buffer  <<04434>>02465000
area can be allocated for sending asynchronous command records <<04434>>02470000
by calling the procedure B08'get'buffer.  When finished with   <<04434>>02475000
the buffer area, it can be returned to the free-list by calling<<04434>>02480000
B08'release'buffer.  In the case of allocating a buffer area,  <<04434>>02485000
if no buffer area is available from the free-list, the caller  <<04434>>02490000
has the option of specifying whether one of the dedicated buf- <<04434>>02495000
fer areas should be overwritten, or no buffer should be re-    <<04434>>02500000
turned.                                                        <<04434>>02505000
                                                               <<04434>>02510000
                                                               <<04434>>02515000
                                                               <<04434>>02520000
GROUP 10 -- Device status processors                           <<04434>>02525000
                                                               <<04434>>02530000
  Five procedures are responsible for evaluating the four types<<04434>>02535000
of status presently defined by CIPER.  One procedure,          <<04434>>02540000
B08'process'status, determines what type of status has been    <<04434>>02545000
received and calls the appropriate processor procedure.  Each  <<04434>>02550000
processor procedure will move the information from the speci-  <<04434>>02555000
fied record buffer area (where it was received from the periph-<<04434>>02560000
pheral) to a status 'tank' reserved for that type of status.   <<04434>>02565000
Record headers and other unnecessary information is removed    <<04434>>02570000
from the status report as it is moved.  In the case of some    <<04434>>02575000
types of status (particularly the Device Status report), the   <<04434>>02580000
processor procedure will evaluate the contents of the status.  <<04434>>02585000
                                                               <<04434>>02590000
  The four processor procedures are:                           <<04434>>02595000
                                                               <<04434>>02600000
B08'device'status -- processes the Device Status report, which <<04434>>02605000
                     indicates the state of the peripheral,    <<04434>>02610000
                     such as on-line/off-line, power-fail, etc.<<04434>>02615000
                                                               <<04434>>02620000
B08'job'report -- processes the Job Report, which is a summary <<04434>>02625000
                  of job related information.  Included are a  <<04434>>02630000
                  count of sheets printed during the job, etc. <<04434>>02635000
                                                               <<04434>>02640000
B08'rcv'rdy -- processes the Receive Ready report, which is    <<04434>>02645000
               CIPER's 'clear to send' command.  This reports  <<04434>>02650000
               the number of record buffer areas in the peri-  <<04434>>02655000
               pheral which are available for reception of     <<04434>>02660000
               data/command records.                           <<04434>>02665000
                                                               <<04434>>02670000
B08'env'status -- processes the Environmental Status report,   <<04434>>02675000
                  which provides information about the job     <<04434>>02680000
                  stream that can be used for error recovery.  <<04434>>02685000
                                                               <<04434>>02690000
                                                               <<04434>>02695000
                                                               <<04434>>02700000
GROUP 11 -- Record transmission/reception control              <<04434>>02705000
                                                               <<04434>>02710000
  The three procedures in this group maintain control over the <<04434>>02715000
information that goes into the record header of each record.   <<04434>>02720000
B08'build'header places information such as the record opcode, <<04434>>02725000
data'type, start of block and end of block indicators, and     <<04434>>02730000
record header length into each record header as the record     <<04434>>02735000
constructed.  B08'send'record transmits completed records to   <<04434>>02740000
the peripheral, maintaining an incrementing record sequence    <<04434>>02745000
number for error checking by the peripheral.  B08'force'record <<04434>>02750000
is a second entry point to this procedure that bypasses the    <<04434>>02755000
normal protocol, and may only be called when sending a Device  <<04434>>02760000
Clear command to the peripheral.  B08'get'record will attempt  <<04434>>02765000
to receive a record for the calling procedure.  The caller may <<04434>>02770000
specify a particular type of record to look for, or may accept <<04434>>02775000
the first record received.  In either case, B08'get'record     <<04434>>02780000
checks the record sequence number on the incoming record to    <<04434>>02785000
insure that no records have been lost or duplicated, either    <<04434>>02790000
due to the transport service or an error in the peripheral.    <<04434>>02795000
                                                               <<04434>>02800000
                                                               <<04434>>02805000
                                                               <<04434>>02810000
GROUP 12 -- Function code executors                            <<04434>>02815000
                                                               <<04434>>02820000
  This group consists of the following procedures:             <<04434>>02825000
                                                               <<04434>>02830000
B08'read'data -- currently does nothing                        <<04434>>02835000
                                                               <<04434>>02840000
B08'write'data -- builds Write Data records, appends caller's  <<04434>>02845000
                  data if any.  Sends records if/when full.    <<04434>>02850000
                                                               <<04434>>02855000
B08'configure -- sends the Configure record                    <<04434>>02860000
                                                               <<04434>>02865000
B08'device'clear -- performs a device clear sequence to syn-   <<04434>>02870000
                    chronize the protocol between host and per-<<04434>>02875000
                    ipheral.                                   <<04434>>02880000
                                                               <<04434>>02885000
B08'return'job'report -- returns Job Report information from   <<04434>>02890000
                         status tank in CDS.  Can optionally   <<04434>>02895000
                         request new copy of Job Report from   <<04434>>02900000
                         the peripheral.                       <<04434>>02905000
                                                               <<04434>>02910000
B08'end'job -- sends the End of Job record, clears up all job  <<04434>>02915000
               related information in the CDS, and optionally  <<04434>>02920000
               returns the contents of the received Job Report <<04434>>02925000
               to the caller.                                  <<04434>>02930000
                                                               <<04434>>02935000
B08'start'job -- sends the Start of Job record, and sets up    <<04434>>02940000
                 the default access mode (FEATURE or TRANSPAR- <<04434>>02945000
                 ENT) as defined by the device subtype.        <<04434>>02950000
                                                               <<04434>>02955000
B08'buf'device'status -- returns the contents of the Device    <<04434>>02960000
                         Status to the caller.  Can optionally <<04434>>02965000
                         request a new copy from the peripher- <<04434>>02970000
                         al.                                   <<04434>>02975000
                                                               <<04434>>02980000
B08'buffered'env'status -- returns the contents of the last    <<04434>>02985000
                           Environmental Status report to the  <<04434>>02990000
                           caller.  Can optionally request a   <<04434>>02995000
                           new copy from the peripheral.       <<04434>>03000000
                                                               <<04434>>03005000
B08'available'status -- returns a bit mask to the caller to    <<04434>>03010000
                        inform what types of peripheral status <<04434>>03015000
                        reports have been received since the   <<04434>>03020000
                        last time they were read by the caller.<<04434>>03025000
                                                               <<04434>>03030000
B08'device'close -- bufferes a conditional top of form command,<<04434>>03035000
                    makes sure all pending records are sent,   <<04434>>03040000
                    ends the current job, if any, and cleans   <<04434>>03045000
                    up certain information in the CDS.         <<04434>>03050000
                                                               <<04434>>03055000
B08'file'open -- buffers a conditional top of form escape se-  <<04434>>03060000
                 quence.  If this is the first fopen request   <<04434>>03065000
                 (i.e. allocating device for 'hot' user or     <<04434>>03070000
                 spooler), then TOF request sent to peripheral.<<04434>>03075000
                                                               <<04434>>03080000
B08'end'block -- causes the end of block bit in the current    <<04434>>03085000
                 Write Data record header to be set, then the  <<04434>>03090000
                 record is transmitted to the peripheral.      <<04434>>03095000
                                                               <<04434>>03100000
B08'start'block -- causes a new record to be started with the  <<04434>>03105000
                   start of block bit set in the record header.<<04434>>03110000
                   In addition, a double word block label is   <<04434>>03115000
                   placed in the record immediately after the  <<04434>>03120000
                   record header.                              <<04434>>03125000
                                                               <<04434>>03130000
B08'silent'run -- constructs a Silent Run record and transmits <<04434>>03135000
                  that record to the peripheral.  This places  <<04434>>03140000
                  the peripheral in the silent run recovery    <<04434>>03145000
                  mode, which allows the peripheral to recover <<04434>>03150000
                  from various errors without having to reprint<<04434>>03155000
                  large parts of the job.                      <<04434>>03160000
                                                               <<04434>>03165000
B08'control'mask -- constructs a Configure record with a data  <<04434>>03170000
                    type of Control Mask, then sends that re-  <<04434>>03175000
                    cord to the peripheral.  The control mask  <<04434>>03180000
                    allows the system discretion about which   <<04434>>03185000
                    escape sequences and ASCII control codes   <<04434>>03190000
                    the peripheral will execute.               <<04434>>03195000
                                                               <<04434>>03200000
B08'set'ext'mode -- allows the caller to override the default  <<04434>>03205000
                    access option set up a start of job.       <<04434>>03210000
                                                               <<04434>>03215000
B08'set'status'types -- sets a mask kept in the Level 7 CBI    <<04434>>03220000
                        which determines the types of status   <<04434>>03225000
                        reports the caller is interested in    <<04434>>03230000
                        knowing about.  If the caller enables  <<04434>>03235000
                        a particular type of status, and during<<04434>>03240000
                        the course of time one of those status <<04434>>03245000
                        reports is received from the peripher- <<04434>>03250000
                        al, the caller will be informed by a   <<04434>>03255000
                        %41 ATTACHIO return (instead of the    <<04434>>03260000
                        normal %1).                            <<04434>>03265000
                                                               <<04434>>03270000
B08'flush'out'buffers -- causes any pending records to be sent <<04434>>03275000
                         to the device, even if they are not   <<04434>>03280000
                         filled to the maximum size.           <<04434>>03285000
                                                               <<04434>>03290000
B08'erase'buffers -- causes any pending records to be scrapped <<04434>>03295000
                     so they will never be sent to the periph- <<04434>>03300000
                     eral.                                     <<04434>>03305000
                                                               <<04434>>03310000
                                                               <<04434>>03315000
                                                               <<04434>>03320000
Each of the procedures in this group performs the work for a   <<04434>>03325000
particular MPE function code.  One of the function executors,  <<04434>>03330000
B08'write'data, is used for a variety of MPE function codes.   <<04434>>03335000
This is possible due to the fact that many of the function     <<04434>>03340000
codes supported by B08'logical'dvr are merely translated into  <<04434>>03345000
device escape sequences which can be buffered in a Write Data  <<04434>>03350000
record.                                                        <<04434>>03355000
                                                               <<04434>>03360000
                                                               <<04434>>03365000
                                                               <<04434>>03370000
GROUP 13 -- Debugging and analysis tools                       <<04434>>03375000
                                                               <<04434>>03380000
  Several procedures in the SOFTIO module are used only to     <<04434>>03385000
make debugging more convenient, or to perform certain types of <<04434>>03390000
performance analysis.  These procedures are not compiled unless<<04434>>03395000
one or both of the compiler flags X7 and X9 are set ON.        <<04434>>03400000
                                                               <<04434>>03405000
  Compiler flag X7 controls the inclusion of several procedures<<04434>>03410000
and related code that implements an internal logging facility. <<04434>>03415000
This facility can be used to log information to a set of extra <<04434>>03420000
data segments which are arranged in a two-way linked list.  New<<04434>>03425000
data segments are allocated as the one in use becomes full.    <<04434>>03430000
Currently, the only thing logged is the calling parameters to  <<04434>>03435000
B08'logical'dvr, which includes the completion status and ex-  <<04434>>03440000
cution time in milliseconds.  The procedures included are:     <<04434>>03445000
                                                               <<04434>>03450000
B08'init'log'dst -- initializes the logging facility the first <<04434>>03455000
                    time a log entry is written.               <<04434>>03460000
                                                               <<04434>>03465000
B08'enable'logging -- enables an individual event or optionally<<04434>>03470000
                      all events defined to be logged.         <<04434>>03475000
                                                               <<04434>>03480000
B08'disable'logging -- disables an individual event or option- <<04434>>03485000
                       ally all events defined from being log- <<04434>>03490000
                       ged.                                    <<04434>>03495000
                                                               <<04434>>03500000
  Compiler flag X9 controls the inclusion of several procedures<<04434>>03505000
and related code that facilitates debugging and testing.  When <<04434>>03510000
X9 is set ON, three function executor procedures are included, <<04434>>03515000
as well as code in B08'logical'dvr to call the executors when  <<04434>>03520000
the logical driver is called with certain normally invalid     <<04434>>03525000
function codes.  The procedures are:                           <<04434>>03530000
                                                               <<04434>>03535000
B08'debug'softkeys -- transmits escape sequences to $STDLIST   <<04434>>03540000
                      which, if $STDLIST is an HP2647 or HP2626<<04434>>03545000
                      terminal, will load the softkeys with    <<04434>>03550000
                      debug commands to display the Level 7    <<04434>>03555000
                      CBI, certain record buffer areas, and the<<04434>>03560000
                      calling parameters to B08'logical'dvr.   <<04434>>03565000
                                                               <<04434>>03570000
Cpr'test'shutdown -- used to invoke a shutdown while nested    <<04434>>03575000
                     procedure calls are on the stack.         <<04434>>03580000
                                                               <<04434>>03585000
B08'set'rec'length -- alters the value used to indicate the    <<04434>>03590000
                      maximum size of record accepted by the   <<04434>>03595000
                      peripheral.                              <<04434>>03600000
                                                               <<04434>>03605000
                                                               <<04434>>03610000
                                                               <<04434>>03615000
GROUP 14 -- Logical driver miscellaneous                       <<04434>>03620000
                                                               <<04434>>03625000
  This group contains procedures which just don't fit into any <<04434>>03630000
other group.  These procedures are not in one spot in the      <<04434>>03635000
module, but rather are scattered about.  In front to back order<<04434>>03640000
they are:                                                      <<04434>>03645000
                                                               <<04434>>03650000
B08'hash'function'code -- uses a PB array to hash the disjoint <<04434>>03655000
                          set of MPE function codes supported  <<04434>>03660000
                          by SOFTIO into a contiguous set that <<04434>>03665000
                          can be used to make case statement   <<04434>>03670000
                          selections.                          <<04434>>03675000
                                                               <<04434>>03680000
B08'clean'comp'status -- Clears the composite status area at   <<04434>>03685000
                         the start of certain calls to the     <<04434>>03690000
                         logical driver.  The only time the    <<04434>>03695000
                         composite status area is not cleared  <<04434>>03700000
                         is when the caller is asking what     <<04434>>03705000
                         types of status is available, or when <<04434>>03710000
                         requesting certain types of status.   <<04434>>03715000
                                                               <<04434>>03720000
                                                               <<04434>>03725000
                                                               <<04434>>03730000
GROUP 15 -- CIPER entry point (B08'logical'dvr)                <<04434>>03735000
                                                               <<04434>>03740000
  The entry point to the entire CIPER subsystem is the pro-    <<04434>>03745000
cedure B08'logical'dvr.  Its task is to get DB changed to the  <<04434>>03750000
CDS (and get a CDS initialized the first time called), evalu-  <<04434>>03755000
ate the calling parameters, call the appropriate function      <<04434>>03760000
executor, set up the return status (including an IOQ if no-    <<04434>>03765000
wait IO had been specified), release the CDS and change DB     <<04434>>03770000
back to where it was when called, and return to ATTACHIO.      <<04434>>03775000
                                                               <<04434>>03780000
                                                               <<04434>>03785000
                                                               <<04434>>03790000
$PAGE "NOTES ON RESEGMENTING SOFTIO"                           <<04434>>03795000
             A NOTE ABOUT RESEGMENTING SOFTIO                  <<04434>>03800000
                                                               <<04434>>03805000
  As promised earlier, there are a couple of points to be con- <<04434>>03810000
sidered before spliting SOFTIO into multiple code segments.  A <<04434>>03815000
brief monologue on that subject is now appropriate.            <<04434>>03820000
                                                               <<04434>>03825000
  First, SOFTIO is a very large tree structure, rather than a  <<04434>>03830000
multiple parallel path type of structure (such as the file     <<04434>>03835000
system, with many user callable entry points).  As such, there <<04434>>03840000
is no clear breaking point for segmentation that will reduce   <<04434>>03845000
the number of PCALs to an external SST.  About the only break  <<04434>>03850000
that will accomplish the task of reducing external PCALs is to <<04434>>03855000
move all of the CDS initialization to a separate code segment. <<04434>>03860000
Also, the CDS integrity trap procedures (Group 2) could be     <<04434>>03865000
moved.  This would account for over 1700 decimal words of code <<04434>>03870000
(probably more as initialization became more complex), which   <<04434>>03875000
is roughly 21% of the code space.                              <<04434>>03880000
                                                               <<04434>>03885000
  Second, the current shutdown mechanism depends upon the fact <<04434>>03890000
that all of SOFTIO's code is in a single code segment.  This   <<04434>>03895000
is because it walks back down the stack, looking for the CST   <<04434>>03900000
number in the stack marker to change, so it can tell when the  <<04434>>03905000
ATTACHIO stack marker has been found.  A more refined shutdown <<04434>>03910000
mechanism will have to be implemented (hopefully it will be    <<04434>>03915000
for other reasons as well) before SOFTIO can be split into     <<04434>>03920000
more than one code segment.                                    <<04434>>03925000
                                                               <<04434>>03930000
;                                                              <<04434>>03935000
$PAGE "MPE TABLE ACCESS: GENERAL ABBREVIATIONS"                         03940000
COMMENT                                                                 03945000
                                                                        03950000
buf             := buffer                                               03955000
dev             := device                                               03960000
dflt            := default                                              03965000
ent             := entry                                                03970000
indx            := index                                                03975000
ldev            := logical device                                       03980000
lvl             := level                                                03985000
sd              := serial disc                                          03990000
tbl             := table                                                03995000
vol             := volume                                               04000000
                                                                        04005000
;                                                                       04010000
                                                                        04015000
$INCLUDE INCLGLBL                                                       04020000
                                                                        04025000
$PAGE "MPE TABLE ACCES:  LPDT"                                          04030000
                                                               <<07425>>04035000
                                                               <<07425>>04040000
$INCLUDE INCLLPDT                                              <<07425>>04045000
                                                               <<07425>>04050000
                                                               <<07425>>04055000
                                                               <<07425>>04060000
                                                               <<07425>>04065000
                                                               <<07425>>04070000
                                                               <<07425>>04075000
                                                               <<07425>>04080000
                                                               <<07425>>04085000
                                                               <<07425>>04090000
                                                               <<07425>>04095000
                                                               <<07425>>04100000
                                                               <<07425>>04105000
                                                               <<07425>>04110000
                                                               <<07425>>04115000
                                                               <<07425>>04120000
                                                               <<07425>>04125000
                                                               <<07425>>04130000
                                                               <<07425>>04135000
                                                               <<07425>>04140000
                                                               <<07425>>04145000
                                                               <<07425>>04150000
                                                               <<07425>>04155000
                                                               <<07425>>04160000
                                                               <<07425>>04165000
                                                               <<07425>>04170000
$INCLUDE INCLLDT5                                              <<07425>>04175000
                                                                        04180000
                                                               <<07425>>04185000
$INCLUDE INCLIOQ                                               <<07425>>04190000
$INCLUDE INCLPCB5                                              <<07425>>04195000
                                                                        04200000
$PAGE "MPE TABLE ACCESS: CIPER CONTROL DATA SEGMENT (CIPER CDS)"        04205000
equate                                                                  04210000
        << Control Data Segment (cds) >>                                04215000
       cds'area'size          = -2                                      04220000
      ,cds'area'type          = -1                                      04225000
                                                                        04230000
      ,cds'area'offset        = -cds'area'size                          04235000
      ,cds'area'overhead      = 1 + cds'area'offset                     04240000
;                                                                       04245000
define                                                                  04250000
       cds'area'suptype       = cds'area'type).(0:8 #                   04255000
      ,cds'area'subtype       = cds'area'type).(8:8 #                   04260000
;                                                                       04265000
equate                                                                  04270000
        << Segment Header Area (sha) >>                                 04275000
       sha'segment'offset     = cds'area'offset                         04280000
      ,sha'type'def           = [8/1,8/0]                               04285000
      ,sha'free'space'tbl'ptr = 0                                       04290000
      ,sha'cds'dst'num        = 1 + sha'free'space'tbl'ptr              04295000
      ,sha'max'seg'size       = 1 + sha'cds'dst'num                     04300000
      ,sha'seg'size           = 1 + sha'max'seg'size                    04305000
      ,sha'ctm'ptr            = 1 + sha'seg'size                        04310000
      ,sha'lioq'list'ptr      = 1 + sha'ctm'ptr                         04315000
      ,sha'size               = 1 + sha'lioq'list'ptr                   04320000
                                                                        04325000
        << Control Table Map (ctm) >>                                   04330000
          << entry 0 >>                                                 04335000
      ,ctm'type'def           = [8/2,8/0]                               04340000
      ,ctm0'ent'cnt           = 0                                       04345000
      ,ctm0'ctm'size          = 1 + ctm0'ent'cnt                        04350000
      ,ctm0'ent'inuse'cnt     = 1 + ctm0'ctm'size                       04355000
      ,ctm0'size              = 1 + ctm0'ent'inuse'cnt                  04360000
        <<currently ctm0'size < ctm'ent'size>>                          04365000
          << entries one to ctm(ctm0'ent'cnt) >>                        04370000
      ,ctm'ct'ptr             = 0                                       04375000
      ,ctm'ldev               = 1 + ctm'ct'ptr                          04380000
      ,ctm'ent'size           = 1 + ctm'ldev                            04385000
;                                                                       04390000
equate                                                                  04395000
        << Control Table (ct) >>                                        04400000
       ct'suptype'def         = [8/3,8/0]                               04405000
      ,ct'sir                 = 0                                       04410000
      ,ct'sir'save            = 1 + ct'sir                              04415000
      ,ct'cds'dst'num         = 1 + ct'sir'save                         04420000
      ,ct'ctmi                = 1 + ct'cds'dst'num                      04425000
      ,ct'msw'callers'db      = 1 + ct'ctmi                             04430000
      ,ct'lsw'callers'db      = 1 + ct'msw'callers'db                   04435000
      ,ct'd'callers'db        =     ct'msw'callers'db/2                 04440000
      ,ct'callers'stk         = 1 + ct'lsw'callers'db                   04445000
      ,ct'callers'stk'db      = 1 + ct'callers'stk                      04450000
      ,ct'lvl'cnt             = 1 + ct'callers'stk'db                   04455000
      ,ct'lvl'active          = 1 + ct'lvl'cnt                          04460000
           << if = 0 then ciper is quiesced,                            04465000
              if = -1 then ciper not initialized.>>                     04470000
      ,ct'lvl'active'ptr      = 1 + ct'lvl'active                       04475000
      ,ct'vdt'ptr             = 1 + ct'lvl'active'ptr                   04480000
      ,ct'size'min            = 1 + ct'vdt'ptr                          04485000
                                                                        04490000
      ,ct'lvln'cb'ptr         =     ct'vdt'ptr                          04495000
                                                                        04500000
      ,ct'lvl1'cb'ptr         = 1 + ct'lvln'cb'ptr                      04505000
      ,ct'lvl2'cb'ptr         = 1 + ct'lvl1'cb'ptr                      04510000
      ,ct'lvl3'cb'ptr         = 1 + ct'lvl2'cb'ptr                      04515000
      ,ct'lvl4'cb'ptr         = 1 + ct'lvl3'cb'ptr                      04520000
      ,ct'lvl5'cb'ptr         = 1 + ct'lvl4'cb'ptr                      04525000
      ,ct'lvl6'cb'ptr         = 1 + ct'lvl5'cb'ptr                      04530000
      ,ct'lvl7'cb'ptr         = 1 + ct'lvl6'cb'ptr                      04535000
;                                                                       04540000
define                                                                  04545000
       ct'size                = ct(ct'lvl'cnt) + ct'size'min #          04550000
;                                                                       04555000
equate                                                                  04560000
        << Control Block (cb) >>                                        04565000
       cb'suptype'def         = [8/4,8/0]                               04570000
      ,cb'plabel              = 0                                       04575000
      ,cb'qh'ptr              = 1 + cb'plabel                           04580000
      ,cb'info'ptr            = 1 + cb'qh'ptr                           04585000
      ,cb'cbi'ptr             =     cb'info'ptr                         04590000
      ,cb'size                = 1 + cb'info'ptr                         04595000
;                                                                       04600000
equate                                                                  04605000
        << Queue Header (qh) >>                                         04610000
       qh'suptype'def         = [8/5,8/0]                               04615000
      ,qh'free'list'ptr       = 0                                       04620000
      ,qh'head'request'qe'ptr = 1 + qh'free'list'ptr                    04625000
      ,qh'tail'request'qe'ptr = 1 + qh'head'request'qe'ptr              04630000
      ,qh'head'response'qe'ptr= 1 + qh'tail'request'qe'ptr              04635000
      ,qh'tail'response'qe'ptr= 1 + qh'head'response'qe'ptr             04640000
      ,qh'qe'size             = 1 + qh'tail'response'qe'ptr             04645000
      ,qh'inuse'cnt           = 1 + qh'qe'size                          04650000
      ,qh'free'cnt            = 1 + qh'inuse'cnt                        04655000
      ,qh'max'inuse'cnt       = 1 + qh'free'cnt                         04660000
      ,qh'size                = 1 + qh'max'inuse'cnt                    04665000
;                                                                       04670000
equate                                                                  04675000
        << Queue Element (or Entry) (qe) >>                             04680000
       qe'suptype'def         = [8/6,8/0]                               04685000
      ,qe'flags               = 0                                       04690000
           <<comq relational (family) links>>                           04695000
      ,qe'father'ptr          = 1 + qe'flags                            04700000
      ,qe'lioq'indx           =     qe'father'ptr                       04705000
      ,qe'head'brother'ptr    = 1 + qe'father'ptr                       04710000
      ,qe'tail'brother'ptr    = 1 + qe'head'brother'ptr                 04715000
      ,qe'head'son'ptr        = 1 + qe'tail'brother'ptr                 04720000
      ,qe'tail'son'ptr        = 1 + qe'head'son'ptr                     04725000
           <<comq sequential (queue) links>>                            04730000
      ,qe'qh'ptr              = 1 + qe'tail'son'ptr                     04735000
      ,qe'head'qe'ptr         = 1 + qe'qh'ptr                           04740000
      ,qe'tail'qe'ptr         = 1 + qe'head'qe'ptr                      04745000
      ,qe'next'free'ptr       =     qe'tail'qe'ptr                      04750000
      ,qe'size'min            = 1 + qe'tail'qe'ptr                      04755000
;                                                                       04760000
define                                                                  04765000
       qe'abort               = qe'flags).(0:1 #                        04770000
      ,qe'abort'process       = qe'flags).(1:1 #                        04775000
      ,qe'CIP'request         = qe'flags).(2:1 #                        04780000
      ,qe'origin              = qe'flags).(3:2 #                        04785000
      ,qe'father'is'lioq'indx = qe'flags).(5:1 #                        04790000
      ,qe'is'lioq'indx        = qe'flags).(6:1 #                        04795000
      ,qe'is'free             = qe'flags).(7:1 #                        04800000
;                                                                       04805000
equate                                                                  04810000
       qe'origin'father       = +1                                      04815000
      ,qe'origin'brother      = -1                                      04820000
      ,qe'origin'same'level   =  0                                      04825000
;                                                                       04830000
equate                                                                  04835000
        << Queue Element Information (qei) >>                           04840000
       qei'suptype'def        = [8/7,8/0]                               04845000
      ,qei'internal'func'code = 0                                       04850000
; <<need further definitions here>>                                     04855000
equate                                                                  04860000
        << Queue Element information for the lioq (qe'lioq) >>          04865000
       qe'lioq'ldev           =     qe'size'min                         04870000
      ,qe'lioq'qmisc          = 1 + qe'lioq'ldev                        04875000
      ,qe'lioq'dstx           = 1 + qe'lioq'qmisc                       04880000
      ,qe'lioq'addr           = 1 + qe'lioq'dstx                        04885000
      ,qe'lioq'fnct           = 1 + qe'lioq'addr                        04890000
      ,qe'lioq'cnt            = 1 + qe'lioq'fnct                        04895000
      ,qe'lioq'p1             = 1 + qe'lioq'cnt                         04900000
      ,qe'lioq'p2             = 1 + qe'lioq'p1                          04905000
      ,qe'lioq'flags          = 1 + qe'lioq'p2                          04910000
      ,qe'lioq'size'min       = 1 + qe'lioq'flags                       04915000
;                                                                       04920000
equate                                                                  04925000
        << Control Block Information (cbi) >>                           04930000
       cbi'suptype'def        = [8/8,8/0]                               04935000
;                                                                       04940000
equate                                                                  04945000
        << Control Block Information eXtension (cbix) >>                04950000
       cbix'suptype'def       = [8/9,8/0]                               04955000
;                                                                       04960000
equate                                                                  04965000
        << general cds area management declarations>>                   04970000
       nul'dseg               = -1                                      04975000
;                                                                       04980000
define                                                                  04985000
       nul'db                 = -1D#                                    04990000
;                                                                       04995000
                                                                        05000000
  <<ciper data segment management overview>>                            05005000
$PAGE "CIPER DATA SEGMENT (CDS) MANAGEMENT OVERVIEW"                    05010000
COMMENT                                                                 05015000
                     |                                                  05020000
                     V                                                  05025000
             @ct:=cpr'get'ct'of(ldev) +                                 05030000
                     |                                                  05035000
 (no cdda dseg)<-----+----->(cdda dseg)                                 05040000
cpr'init'cdda'for(ldev) +     |                                         05045000
  cpr'get'cdda(ldev) +        |                                         05050000
    getdataseg                |    +-------------------------------     05055000
  (set DB to cdda dseg)       |    | ciper'engine                       05060000
    cpr'init'cds +            |    |                                    05065000
      cpr'init'sha +          |    |   @ct:=cpr'get'ct'of(ldev) +       05070000
        cpr'init'cds'area +   |    |                                    05075000
      cpr'init'cntl'of'cds'area +| |     @cb:=cpr'cb'of(ct, level) *    05080000
      cpr'init'ctm +          |    |   cpr'rel'ct(ct) +                 05085000
      cpr'init'lioq +         |    |                                    05090000
       [cpr'init'lioq'es]     |    +-------------------------------     05095000
  cpr'get'ctmi +              |    |  ptr:=cpr'get'cds'area +           05100000
  cpr'init'ct +               |    |  ptr:=cpr'get'2ndary'cds'area      05105000
    cpr'init'cb +             |    |    ptr:=cpr'init'cds'area +        05110000
      cpr'init'queues         |    |  ptr:=cpr'rel'cds'area +           05115000
        cpr'init'qh           |    |                                    05120000
                              |    |size:=cpr'size'of'cds'area(ptr) +   05125000
          cpr'init'qe'es      |    |  cpr'lock'cds'area +               05130000
          cpr'enq'init'cmd    |    |  cpr'unlock'cds'area +             05135000
  (set DB to callers dseg)    |    +-------------------------------     05140000
  cpr'cond'chg'ldtx +         |                                         05145000
  (set DB to cdda dseg)  (set DB to cdda dseg)                          05150000
        |                     |                                         05155000
        +----------+----------+                                         05160000
                   |                                                    05165000
                                                                        05170000
'.' := outline done                                                     05175000
':' := code written                                                     05180000
'+' := code verified, needs work on documentation                       05185000
'*' := code verified, documentation up to date                          05190000
-----------------------------------+-------------------------------     05195000
@cbi:=cpr'init'cbi(cb, size) +     |  cpr'internal'error +              05200000
@cbix:=cpr'init'cbix(cbi, size)    |  cpr'coding'error +                05205000
                                   |  cpr'interference +                05210000
;                                                                       05215000
                                                                        05220000
$PAGE "CIPER DATA SEGMENT (CDS) COMMUNICATION QUEUE (COMQ) OVERVIEW"    05225000
COMMENT                                                                 05230000
                                                                        05235000
   cpr'get'comq                               cpr'rel'comq              05240000
                                                                        05245000
                                                                        05250000
cpr'request'transmit                      cpr'response'receive          05255000
                                                                        05260000
                                                                        05265000
                            (Level n)                                   05270000
----------------------------------------------------------------        05275000
                           (Level n-1)                                  05280000
                                                                        05285000
                                                                        05290000
cpr'request'receive                       cpr'response'transmit         05295000
                     (request -> response)                              05300000
                     (  common handling  )                              05305000
                     (      routines     )                              05310000
;                                                                       05315000
                                                                        05320000
  <<2608B Specific declarations>>                                       05325000
$PAGE "2608B SPECIFIC DECLARATIONS"                                     05330000
equate                                                                  05335000
       B08'initial'dseg'size = 8192                                     05340000
      ,B08'maximum'dseg'size = 8192                                     05345000
      ,B08'num'ctm'ents      = 1                                        05350000
      ,B08'num'lioq'ents     = 0                                        05355000
      ,B08'ct'lvl'cnt        = 7                                        05360000
;                                                                       05365000
                                                                        05370000
  <<logical driver global declarations>>                                05375000
$PAGE "SUPPORTED CIPER DEVICE TYPES/SUBTYPES"                           05380000
  << The following subtypes are supported by the current >>             05385000
  << CIPER implementation.                               >>             05390000
                                                                        05395000
                                                                        05400000
  << For CIPER printer devices (type = 32): >>                          05405000
                                                                        05410000
  equate                                                                05415000
                                                                        05420000
    feature'access'subtype        = 9                                   05425000
      << Ldevs with this subtype default to feature access >>           05430000
      << mode, where escape sequences and control codes in >>           05435000
      << the user's data stream are interpreted.           >>           05440000
                                                                        05445000
   ,transparent'access'subtype    = 13                                  05450000
      << Ldevs with this subtype default to 'transparency' >>           05455000
      << mode, which means that any escape sequences or    >>           05460000
      << control codes in the user's data are printed by   >>           05465000
      << the device.                                       >>           05470000
                                                                        05475000
  ;                                                                     05480000
                                                                        05485000
$PAGE "ATTACHIO 'FLAGS' PARAMETER FIELD DEFINITIONS"                    05490000
                                                                        05495000
  define                                                                05500000
                                                                        05505000
    control'spec                  = ( 0: 4) #                           05510000
      << Control and specification >>                                   05515000
                                                                        05520000
   ,premption                     = ( 7: 2) #                           05525000
      << Preemption: 1 = soft, 2 = hard >>                              05530000
                                                                        05535000
   ,special'request               = (10: 1) #                           05540000
      << Device defined special request >>                              05545000
                                                                        05550000
   ,diagnostic'request            = (11: 1) #                           05555000
      << request made by diagnostician >>                               05560000
                                                                        05565000
   ,system'buffers                = (12: 1) #                           05570000
      << If set, address is really system buffer index >>               05575000
                                                                        05580000
   ,request'type                  = (13: 3) #                           05585000
      << request type of flags parameter >>                             05590000
                                                                        05595000
   ,impede'bit                    = (13: 1) #                           05600000
      << If set, caller not to be impeded until IOQ becomes >>          05605000
      << available.                                         >>          05610000
                                                                        05615000
   ,wake'bit                      = (14: 1) #                           05620000
      << In request types 0, 2, 4, and 6 this bit specifies >>          05625000
      << that the caller is to be woken upon completion of  >>          05630000
      << the request.                                       >>          05635000
                                                                        05640000
  ;                                                                     05645000
                                                                        05650000
                                                                        05655000
                                                                        05660000
$PAGE "MPE FILE SYSTEM FUNCTION CODES SUPPORTED BY CIPER"               05665000
  << The following list includes all function codes that   >>           05670000
  << cause specific actions by the CIPER logical driver.   >>           05675000
  << There are two possible actions for any function codes >>           05680000
  << not in this list:                                     >>           05685000
  <<                                                       >>           05690000
  << a. If the function code is in the range of 0 - 127,   >>           05695000
  <<    the logical driver will return an invalid'request  >>           05700000
  <<    completion status.                                 >>           05705000
  <<                                                       >>           05710000
  << b. If the function code is in the range of 128 - 192, >>           05715000
  <<    the logical driver will ignor the request and re-  >>           05720000
  <<    turn a successful completion status.  The count    >>           05725000
  <<    specified by ATTACHIO will be echoed back.  This   >>           05730000
  <<    allows files/programs designed for other intelle-  >>           05735000
  <<    gent devices to be output to a CIPER device with-  >>           05740000
  <<    out file system errors.                            >>           05745000
                                                                        05750000
  equate                                                                05755000
                                                                        05760000
    read                          = 0                                   05765000
      << read data from device >>                                       05770000
                                                                        05775000
   ,write                         = 1                                   05780000
      << write data to device >>                                        05785000
                                                                        05790000
   ,file'open                     = 2                                   05795000
      << file open/device allocation >>                                 05800000
                                                                        05805000
   ,file'close                    = 3                                   05810000
      << file close >>                                                  05815000
                                                                        05820000
   ,device'close                  = 4                                   05825000
      << device deallocation >>                                         05830000
                                                                        05835000
   ,device'status'immediate       = 15                                  05840000
      << gets immediate device status >>                                05845000
                                                                        05850000
   ,vfu'download                  = 64                                  05855000
      << downloads user vfu definition >>                               05860000
                                                                        05865000
   ,set'left'margin               = 65                                  05870000
      << sets programmable left margin >>                               05875000
                                                                        05880000
   ,device'status'buffered        = 71                                  05885000
      << gets buffered device status >>                                 05890000
                                                                        05895000
   ,self'test                     = 73                                  05900000
      << initiates device self test >>                                  05905000
                                                                        05910000
   ,char'set'select               = 128                                 05915000
      << select character set >>                                        05920000
                                                                        05925000
   ,phys'page'len                 = 133                                 05930000
      << define physical page length >>                                 05935000
                                                                        05940000
   ,page'control                  = 140                                 05945000
      << page control >>                                                05950000
                                                                        05955000
   ,clear'environment             = 141                                 05960000
      << clears device environment to default state >>                  05965000
                                                                        05970000
   ,start'job                     = 142                                 05975000
      << starts user job on device >>                                   05980000
                                                                        05985000
   ,load'default'environment      = 143                                 05990000
      << loads default environment into device >>                       05995000
                                                                        06000000
   ,end'job                       = 145                                 06005000
      << completes user job on device >>                                06010000
                                                                        06015000
   ,extended'cap'mode             = 146                                 06020000
      << Enables/disables extended features access by user >>           06025000
                                                                        06030000
   ,start'of'block                = 147                                 06035000
      << Starts new data block with block number >>                     06040000
                                                                        06045000
   ,end'of'block                  = 148                                 06050000
      << Terminates current user data block >>                          06055000
                                                                        06060000
   ,job'report'buffered           = 179                        <<04422>>06065000
      << Requests last copy of job report obtained from >>     <<04422>>06070000
      << the device.                                    >>     <<04422>>06075000
                                                               <<04422>>06080000
   ,env'status'immediate          = 180                                 06085000
      << Reads a fresh copy of the environmental status     >>          06090000
      << from the device.                                   >>          06095000
                                                                        06100000
   ,device'status'composite       = 181                                 06105000
      << requests return of composite device status info >>             06110000
                                                                        06115000
   ,send'any'pending'records      = 182                                 06120000
      << Forces any pending output record buffers to be     >>          06125000
      << sent to the device, even if they are not yet full. >>          06130000
                                                                        06135000
   ,erase'buffers                 = 183                                 06140000
      << Causes any pending input or output record buffers  >>          06145000
      << to be purged and initialized.  Used when caller    >>          06150000
      << has overwhelming urge to clean up.                 >>          06155000
                                                                        06160000
   ,set'control'mask              = 185                                 06165000
      << downloads control mask to peripheral >>                        06170000
                                                                        06175000
   ,job'report'immediate          = 186                        <<04422>>06180000
      << Returns end of job information to caller >>                    06185000
                                                                        06190000
   ,read'avail'status'types       = 187                                 06195000
      << Returns bit mask indicating types of status avail- >>          06200000
      << able to caller                                     >>          06205000
                                                                        06210000
   ,set'avail'status'types        = 188                                 06215000
      << Sets mask defining which types of peripheral status >>         06220000
      << reports are desired by the caller.                  >>         06225000
                                                                        06230000
   ,device'clear                  = 189                                 06235000
      << perform device clear >>                                        06240000
                                                                        06245000
   ,load'silent'run               = 190                                 06250000
      << downloads silent run block >>                                  06255000
                                                                        06260000
   ,environmental'status          = 191                                 06265000
      << reads environmental status block from device >>                06270000
                                                                        06275000
  ;                                                                     06280000
                                                                        06285000
                                                                        06290000
$PAGE "CIPER INTERNAL (LEVEL 7 TO LEVEL 4) FUNCTION CODES"              06295000
  << The following list defines the currently supported    >>           06300000
  << function codes that are used by the logical driver    >>           06305000
  << (Level 7) when making requests of the transport con-  >>           06310000
  << trol (Level 4).                                       >>           06315000
                                                                        06320000
  equate                                                                06325000
                                                                        06330000
    transport'read                = 0                                   06335000
      << reads record from device >>                                    06340000
                                                                        06345000
   ,transport'write               = 1                                   06350000
      << writes a record to the device >>                               06355000
                                                                        06360000
   ,transport'open                = 2                                   06365000
      << opens (allocates) certain transport services for us >>         06370000
                                                                        06375000
   ,transport'close               = 3                                   06380000
      << equivalent to an fclose (typically a nop) >>                   06385000
                                                                        06390000
   ,transport'deallocate          = 4                                   06395000
      << disconnects the transport service from this user. >>           06400000
                                                                        06405000
   ,transport'initialize          = 5                                   06410000
      << initializes transport service >>                               06415000
                                                                        06420000
   ,transport'status              = 6                                   06425000
      << requests internal status from transport service >>             06430000
                                                                        06435000
  ;                                                                     06440000
                                                                        06445000
                                                                        06450000
$PAGE "CIPER INTER-LEVEL RETURN STATUS FIELD DEFINITIONS"               06455000
  << CIPER will (in the future) use a slightly modified    >>           06460000
  << form of return status than does ATTACHIO and          >>           06465000
  << P'ATTACHIO.  These are internal only, and will be     >>           06470000
  << converted to the normal ATTACHIO format before the    >>           06475000
  << logical driver exits.                                 >>           06480000
                                                                        06485000
  define                                                                06490000
                                                                        06495000
    level'number                  = ( 0: 4) #                           06500000
      << CIPER (ISO) level number generating the error >>               06505000
                                                                        06510000
   ,sub'level'number              = ( 4: 2) #                           06515000
      << CIPER sub level (allows for internal expansion) >>             06520000
      << Currently reserved - set to zero                >>             06525000
                                                                        06530000
   ,type'of'error                 = ( 6: 2) #                           06535000
      << Indicates severity of error - defined as follows: >>           06540000
      <<   0 ::= No error (successful completion)          >>           06545000
      <<   1 ::= Warning (unusual event occurred)          >>           06550000
      <<   2 ::= Error occurred but recovery took place    >>           06555000
      <<   3 ::= Error irrecoverable at this level         >>           06560000
                                                                        06565000
   ,error'code                    = ( 8: 8) #                           06570000
      << Specific error number.  One (1) ALWAYS means suc- >>           06575000
      << cessful completion.                               >>           06580000
                                                                        06585000
  ;                                                                     06590000
                                                                        06595000
                                                                        06600000
$PAGE "CIPER INTERNAL RETURN STATUS CODES (BY LEVEL)"                   06605000
  equate                                                                06610000
                                                                        06615000
    no'errors                     = 1                                   06620000
      << good completion >>                                             06625000
                                                                        06630000
   ,fatal'error                   = %314                                06635000
      << error fatal to b08'logical'dvr >>                              06640000
                                                                        06645000
   ,invalid'function              = 4                                   06650000
      << function code not supported by this logical driver >>          06655000
                                                                        06660000
   ,invalid'request               = 4                                   06665000
      << request not valid for this device >>                           06670000
                                                                        06675000
   ,wrong'creator                 = %304                                06680000
      << creator bit of record header not correct >>                    06685000
                                                                        06690000
   ,record'sequence'error         = %304                                06695000
      << record received out of sequence >>                             06700000
                                                                        06705000
   ,record'active'error           = %314                                06710000
      << attempted to start new record while previous >>                06715000
      << record still not completely sent.            >>                06720000
                                                                        06725000
   ,no'error                      = no'errors                           06730000
      << indicates no error in status processor >>                      06735000
                                                                        06740000
   ,packet'sequence'error         = %304                                06745000
      << indicates packet sequence error in level 4 >>                  06750000
                                                                        06755000
   ,illegal'function'sequence     = %314                                06760000
      << indicates a read or write call to level 4 before   >>          06765000
      <<     initializing >>                                            06770000
                                                                        06775000
   ,illegal'func'cd               = %314                                06780000
      << indicates an undefined function code passed to >>              06785000
      << Level 4                                        >>              06790000
                                                                        06795000
   ,pf'error                      = %213                                06800000
       << indicates an power fail status on last status >>              06805000
                                                                        06810000
   ,error'so'read'status          = %243                                06815000
      << Some device error has been detected in the device >>           06820000
      << status information, so the caller should read the >>           06825000
      << composite status information to determine the na- >>           06830000
      << ture of the error.                                >>           06835000
                                                                        06840000
  ;                                                                     06845000
$PAGE "MPE RETURN STATUS CODE DEFINITIONS"                              06850000
  << MPE currently uses the following definitions for   >>              06855000
  << driver return status.  Not all codes are returned  >>              06860000
  << by any given driver.                               >>              06865000
                                                                        06870000
  equate                                                                06875000
                                                                        06880000
    system'powerfail              = %63                                 06885000
                                                                        06890000
  ;                                                                     06895000
                                                                        06900000
                                                                        06905000
$PAGE "CIPER EXTERNAL RETURN STATUS FIELD DEFINITIONS"                  06910000
  << CIPER accepts from P'ATTACHIO and returns to ATTACHIO >>           06915000
  << completion status in the following format:            >>           06920000
                                                                        06925000
  define                                                                06930000
                                                                        06935000
    pcb'number                    = ( 0: 8) #                           06940000
      << Process control block number of process issuing >>             06945000
      << current request.                                >>             06950000
                                                                        06955000
   ,overall                       = ( 8: 8) #                           06960000
      << concatenation of qualifier and general status,  >>             06965000
      << as defined below:                               >>             06970000
                                                                        06975000
   ,qualifier                     = ( 8: 5) #                           06980000
      << qualification upon general status indication >>                06985000
                                                                        06990000
   ,general                       = (13: 3) #                           06995000
      << General completion status, with the following de- >>           07000000
      << fined values:                                     >>           07005000
      <<   0 ::= pending completion                        >>           07010000
      <<   1 ::= successful                                >>           07015000
      <<   2 ::= end of file                               >>           07020000
      <<   3 ::= unusual condition                         >>           07025000
      <<   4 ::= catastrophic error                        >>           07030000
                                                                        07035000
  ;                                                                     07040000
                                                                        07045000
                                                                        07050000
$PAGE "CIPER EXTERNAL GENERAL RETURN STATUS CODES"                      07055000
  << CIPER will return the following codes in the general  >>           07060000
  << status field of the return status:                    >>           07065000
                                                                        07070000
  equate                                                                07075000
                                                                        07080000
    pending                       = 0                                   07085000
      << Request has not yet completed >>                               07090000
                                                                        07095000
   ,successful                    = 1                                   07100000
      << Requested function completed without errors >>                 07105000
                                                                        07110000
   ,end'of'file                   = 2                                   07115000
      << End of file encountered while servicing request >>             07120000
                                                                        07125000
   ,unusual'condition             = 3                                   07130000
      << Abnormal completion, not necessaraly bad >>                    07135000
                                                                        07140000
   ,catastrophic                  = 4                                   07145000
      << Non-recoverable error occurred somewhere >>                    07150000
                                                                        07155000
  ;                                                                     07160000
                                                                        07165000
                                                                        07170000
                                                                        07175000
$PAGE "CIPER LOGICAL DRIVER RECORD TYPES"                               07180000
                                                                        07185000
  equate                                                                07190000
                                                                        07195000
                                                                        07200000
    << Record types sent from peripheral to host >>                     07205000
                                                                        07210000
    dont'care                     = -1                                  07215000
      << used in cpr'get'record to indicate a don't care >>             07220000
      << condition in the expected record type parameter. >>            07225000
                                                                        07230000
   ,lgl'receive'ready             = 0                                   07235000
      << reports device's ability to accept records >>                  07240000
                                                                        07245000
   ,lgl'clear'response            = 1                                   07250000
      << device response to logical device clear >>                     07255000
                                                                        07260000
   ,lgl'status'report             = 2                                   07265000
      << device response to status request >>                           07270000
                                                                        07275000
   ,lgl'esb'report                = 3                                   07280000
      << Environmental status block report >>                           07285000
                                                                        07290000
   ,lgl'job'report                = 11                                  07295000
      << device response to job end >>                                  07300000
                                                                        07305000
   ,lgl'read'response             = 17                                  07310000
      << device response to data request >>                             07315000
                                                                        07320000
                                                                        07325000
                                                                        07330000
                                                                        07335000
    << Record types sent from host to peripheral: >>                    07340000
                                                                        07345000
   ,lgl'device'clear              = 1                                   07350000
      << resets communication protocol at logical level >>              07355000
                                                                        07360000
   ,lgl'report'status             = 2                                   07365000
      << requests device status report >>                               07370000
                                                                        07375000
   ,lgl'report'esb                = 3                                   07380000
      << Requests the last generated environmental status >>            07385000
      << block, even if the device is not at a checkpoint >>            07390000
                                                                        07395000
   ,lgl'configuration             = 8                                   07400000
      << sends configuration information to device >>                   07405000
                                                                        07410000
   ,lgl'start'job                 = 9                                   07415000
      << starts user job at device >>                                   07420000
                                                                        07425000
   ,lgl'end'job                   = 10                                  07430000
      << completes user job and generates job status >>                 07435000
                                                                        07440000
   ,lgl'report'job'status         = 11                                  07445000
      << Requests job status report while job is still >>               07450000
      << active on device.                             >>               07455000
                                                                        07460000
   ,lgl'silent'run                = 12                                  07465000
      << Places device in the silent run recovery mode >>               07470000
                                                                        07475000
   ,lgl'write                     = 16                                  07480000
      << sends data to the device >>                                    07485000
                                                                        07490000
   ,lgl'read                      = 17                                  07495000
      << requests data from the device >>                               07500000
                                                                        07505000
  ;                                                                     07510000
                                                                        07515000
                                                                        07520000
                                                                        07525000
$PAGE "CIPER LOGICAL DRIVER CONTROL BLOCK INFORMATION (CBI)"            07530000
  << The CIPER logical driver uses the control block infor- >>          07535000
  << mation area (cbi) as an array of global information    >>          07540000
  << that may be used by any of the procedures that make up >>          07545000
  << the driver.  Each procedure will reference the cbi via >>          07550000
  << a pointer variable known as CB'INFO.  The cbi is allo- >>          07555000
  << cated in the CIPER data segment during initialization. >>          07560000
                                                                        07565000
  << Any variables which are listed as pointers actually    >>          07570000
  << contain a CBIX relative address.  The CBIX is an area  >>          07575000
  << of the CIPER data segment allocated during initializa- >>          07580000
  << tion where record buffers and status holding areas are >>          07585000
  << located.  The CBIX is pointed to by the variable       >>          07590000
  << CDS'AREA'BASE, which contains the CIPER data segment   >>          07595000
  << relative address of the base of the CBIX.              >>          07600000
                                                                        07605000
                                                                        07610000
  equate                                                                07615000
                                                                        07620000
    cds'area'base                 = 0                                   07625000
      << address of cds area block >>                                   07630000
                                                                        07635000
   ,initialized                   = 1 + cds'area'base                   07640000
      << flags successful initialization of cds area >>                 07645000
                                                                        07650000
   ,job'active                    = 1 + initialized                     07655000
      << indicates whether job is active on device >>                   07660000
                                                                        07665000
   ,free'buff'list                = 1 + job'active                      07670000
      << head of free-list of record buffer areas >>                    07675000
                                                                        07680000
   ,o'r'base                      = 1 + free'buff'list                  07685000
      << pointer to base of output record buffer area >>                07690000
                                                                        07695000
   ,i'r'base                      = 1 + o'r'base                        07700000
      << pointer to base of input record buffer area >>                 07705000
                                                                        07710000
   ,dev'status'base               = 1 + i'r'base                        07715000
      << address of base of device status area >>                       07720000
                                                                        07725000
   ,composite'status'base         = 1 + dev'status'base                 07730000
      << address of the composite device status area >>                 07735000
                                                                        07740000
   ,env'status'base               = 1 + composite'status'base           07745000
      << address of base of environmental status area >>                07750000
                                                                        07755000
   ,job'report'base               = 1 + env'status'base                 07760000
      << address of base of job report area >>                          07765000
                                                                        07770000
   ,expanded'features             = 1 + job'report'base                 07775000
      << flag for compatibility mode/expanded features >>               07780000
                                                                        07785000
   ,input'sequence'count          = 1 + expanded'features               07790000
      << used to validate incoming records - set to zero  >>            07795000
                                                                        07800000
      << at completion of device clear command            >>            07805000
   ,output'sequence'count         = 1 + input'sequence'count            07810000
                                                                        07815000
      << used to generate record numbers on outbound re-  >>            07820000
      << cords - set to zero at completion of device clear >>           07825000
                                                                        07830000
   ,receive'ready'count           = 1 + output'sequence'count           07835000
      << count of available peripheral buffers >>                       07840000
                                                                        07845000
   ,xlate'flags                   = 1 + receive'ready'count             07850000
      << storage array for function code translator >>                  07855000
                                                                        07860000
   ,sequence'1'buffer             = 2 + xlate'flags                     07865000
      << buffer array for leading escape sequence(s) >>                 07870000
                                                                        07875000
   ,o'r'data'type                 = 1 + sequence'1'buffer               07880000
      << data type of current request(s) >>                             07885000
                                                                        07890000
   ,i'r'data'type                 = 1 + o'r'data'type                   07895000
      << data type of current request(s) >>                             07900000
                                                                        07905000
   ,file'open'count               = 1 + i'r'data'type                   07910000
      << number of outstanding file'opens against device >>             07915000
                                                                        07920000
   ,device'allocated              = 1 + file'open'count                 07925000
      << set to true whenever a caller has allocated the de- >>         07930000
      << vice with at least one fopen call.  Set to false    >>         07935000
      << whenever a device close call is made.               >>         07940000
                                                                        07945000
   ,logical'device                = 1 + device'allocated                07950000
      << logical device that this cb'info is for >>                     07955000
                                                                        07960000
   ,ciper'dst                     = 1 + logical'device                  07965000
      << contains dst number of the dst containing this area >>         07970000
                                                                        07975000
   ,out'recs'overwritten          = 1 + ciper'dst                       07980000
      << counts number of times Device Clear command has to >>          07985000
      << overwrite pending data in output record buffer area >>         07990000
                                                                        07995000
   ,in'recs'overwritten           = 1 + out'recs'overwritten            08000000
      << counts number of times Clear Response has to over- >>          08005000
      << write pending data in the input record buffer area >>          08010000
                                                                        08015000
   ,device'buffer'size            = 1 + in'recs'overwritten             08020000
      << size (in bytes) of peripheral record length >>                 08025000
                                                                        08030000
   ,device'env'status'size        = 1 + device'buffer'size              08035000
      << size (in bytes) of peripheral's maximum length >>              08040000
      << environmental status report                    >>              08045000
                                                                        08050000
   ,product'number                = 1 + device'env'status'size          08055000
      << array to contain ASCII encoded product number >>               08060000
      << returned in Clear Response                    >>               08065000
                                                                        08070000
   ,storage'requirements          = 1 + product'number                  08075000
      << tallies up space needed in permanent cds area >>               08080000
                                                                        08085000
   ,temp'area                     = 1 + storage'requirements            08090000
      << points to base of temporary cds area >>                        08095000
                                                                        08100000
   ,ct'ptr                        = 1 + temp'area                       08105000
      << contains address of control table >>                           08110000
                                                                        08115000
   ,packet'header'size            = 1 + ct'ptr                          08120000
      << contains size of packet header (in words) >>                   08125000
                                                                        08130000
   ,packet'trailer'size           = 1 + packet'header'size              08135000
      << contains size of packet trailer (in words) >>                  08140000
                                                                        08145000
   ,packet'size                   = 1 + packet'trailer'size             08150000
      << Length (in bytes) of largest packet allowed by >>              08155000
      << current configuration of physical level        >>              08160000
                                                                        08165000
   ,dev'clr'count                 = 1 + packet'size                     08170000
      << tally of how many recursions of the device'clear >>            08175000
      << procedure we are making.  If the count exceeds a >>            08180000
      << preset value (currently 3) then there is something >>          08185000
      << serious enough to prevent the clear from complet-  >>          08190000
      << properly.                                          >>          08195000
                                                                        08200000
   ,dev'clr'in'progress           = 1 + dev'clr'count                   08205000
      << Set to true during a device clear sequence to in- >>           08210000
      << hibit record number sequence checking.            >>           08215000
                                                                        08220000
   ,sr'enable                     = 1 + dev'clr'in'progress             08225000
      << used for configuration of status reporting >>                  08230000
                                                                        08235000
   ,esb'frequency                 = 1 + sr'enable                       08240000
      << sets number of checkpoint occurances between en- >>            08245000
      << vironmental status reports sent.                 >>            08250000
                                                                        08255000
   ,logging'dst                   = 1 + esb'frequency                   08260000
      << contains dst number of current logging data segment >>         08265000
                                                                        08270000
   ,logging'buffer                = 1 + logging'dst                     08275000
      << pointer to buffer used in performance logging >>               08280000
                                                                        08285000
   ,event'map                     = 1 + logging'buffer                  08290000
      << bit map that indicates which events are enabled for >>         08295000
      << logging to take place.  If bit 0 is set, logging    >>         08300000
      << suspended temporarily.                              >>         08305000
                                                                        08310000
   ,status'enabled                = 1 + event'map                       08315000
      << bit map of status types whose receipt can cause >>             08320000
      << a special return status to caller.              >>             08325000
                                                                        08330000
   ,status'received               = 1 + status'enabled                  08335000
      << bit map of status types which have been received >>            08340000
                                                                        08345000
   ,status'reported               = 1 + status'received                 08350000
      << bit map of status types whose receipt has been >>              08355000
      << reported to caller via special return code     >>              08360000
                                                                        08365000
   ,default'access'mode           = 1 + status'reported                 08370000
      << determines the access mode granted after every  >>             08375000
      << job start or allocation fopen.                  >>             08380000
                                                                        08385000
   ,comp'stat'available           = 1 + default'access'mode             08390000
      << Flag to indicate whether or not any information is >>          08395000
      << contained in the composite device status area.     >>          08400000
                                                                        08405000
   ,dvr'seq          = 1 + comp'stat'available                 <<07425>>08410000
      << Sequence number of calls to driver.  Incremented >>   <<07425>>08415000
      << each time driver is called.                      >>   <<07425>>08420000
                                                               <<07425>>08425000
   ,cb'info'size                  = 1 + dvr'seq                <<07425>>08430000
      << total size required for cb'info area >>                        08435000
                                                                        08440000
  ;                                                                     08445000
                                                                        08450000
$PAGE                                                                   08455000
  << DEFINITIONS OF CB'INFO SUBPARAMETERS >>                            08460000
                                                                        08465000
  << Bit maps for status'enabled, status'received, and >>               08470000
  << status'reported words:                            >>               08475000
                                                                        08480000
  define                                                                08485000
                                                                        08490000
    dev'stat'bit                  = (14: 1) #                           08495000
      << Device status report >>                                        08500000
                                                                        08505000
   ,env'stat'bit                  = (15: 1) #                           08510000
      << Environmental status report >>                                 08515000
                                                                        08520000
  ;                                                                     08525000
                                                                        08530000
                                                                        08535000
$PAGE "CIPER RECORD BUFFER CONTROL INFORMATION"                         08540000
  << The following information is a part of each buffer     >>          08545000
  << area allocated within the CIPER data segment.  This is >>          08550000
  << referred to as the control portion, and maintains such >>          08555000
  << things as how much data is currently in the buffer,    >>          08560000
  << where the next available byte is, the maximum size of  >>          08565000
  << the record, etc.                                       >>          08570000
                                                                        08575000
                                                                        08580000
  equate                                                                08585000
                                                                        08590000
    length                        = -1                                  08595000
      << length of buffer area (used for all areas) >>                  08600000
                                                                        08605000
   ,forward'link                  = 1 + length                          08610000
      << link to next buffer in queue (nil if none) >>                  08615000
                                                                        08620000
   ,allocated                     = 1 + forward'link                    08625000
      << true if buffer not in free-list >>                             08630000
                                                                        08635000
   ,active                        = 1 + allocated                       08640000
      << record in use (dirty) flag >>                                  08645000
                                                                        08650000
   ,ready                         = 1 + active                          08655000
      << set true when buffer ready for transmission >>                 08660000
                                                                        08665000
   ,start                         = 1 + ready                           08670000
      << starting address of record >>                                  08675000
                                                                        08680000
   ,current'position              = 1 + start                           08685000
      << address of next available word >>                              08690000
                                                                        08695000
   ,current'length                = 1 + current'position                08700000
      << length (in bytes) of record >>                                 08705000
                                                                        08710000
   ,maximum'size                  = 1 + current'length                  08715000
      << maximum allowable length of record >>                          08720000
                                                                        08725000
   ,record'overhead               = maximum'size - length + 1           08730000
      << total space required for record control information >>         08735000
                                                                        08740000
  ;                                                                     08745000
                                                                        08750000
                                                                        08755000
$PAGE "CIPER RECORD HEADER DEFINITIONS"                                 08760000
  << Each record buffer area has space reserved for the     >>          08765000
  << record header.  The parameter bytes are optional for   >>          08770000
  << some records.                                          >>          08775000
                                                                        08780000
                                                                        08785000
  equate                                                                08790000
                                                                        08795000
    rec'head'length               = 4                                   08800000
      << current size of record header (in bytes) >>                    08805000
                                                                        08810000
  ;                                                                     08815000
                                                                        08820000
  define                                                                08825000
                                                                        08830000
    header'length                 = 0).(0:8 #                           08835000
      << length field of record header >>                               08840000
                                                                        08845000
   ,header'sequence'number        = 0).(8:8 #                           08850000
      << sequence number field of record header >>                      08855000
                                                                        08860000
   ,header'opcode                 = 1).(0:8 #                           08865000
      << operation code (defines type of record) >>                     08870000
                                                                        08875000
   ,header'creator                = 1).(8:1 #                           08880000
      << creator field (0=host/1=device) >>                             08885000
                                                                        08890000
   ,sob'flag                      = 1).(9:1 #                           08895000
      << Start of block flag, if set block label to follow >>           08900000
                                                                        08905000
   ,eob'flag                      = 1).(10:1 #                          08910000
      << End of block >>                                                08915000
                                                                        08920000
   ,type'of'data                  = 1).(11:5 #                          08925000
      << type of data contained in record (qualification  >>            08930000
      << of the opcode)                                   >>            08935000
                                                                        08940000
   ,parm'byte'1                   = 2).(0:8 #                           08945000
      << first parameter byte >>                                        08950000
                                                                        08955000
   ,parm'byte'2                   = 2).(8:8 #                           08960000
      << parameter byte two >>                                          08965000
                                                                        08970000
   ,parm'byte'3                   = 3).(0:8 #                           08975000
      << parameter byte three >>                                        08980000
                                                                        08985000
   ,parm'byte'4                   = 3).(8:8 #                           08990000
      << parameter byte four >>                                         08995000
                                                                        09000000
   ,parm'byte'5                   = 4).(0:8 #                           09005000
      << parameter byte five >>                                         09010000
                                                                        09015000
   ,parm'byte'6                   = 4).(8:8 #                           09020000
      << parameter byte six >>                                          09025000
                                                                        09030000
  ;                                                                     09035000
$PAGE "CIPER 'READ' RECORD DEFINITIONS"                                 09040000
  << The type of read becomes the first parameter byte of   >>          09045000
  << a read request record.  The types of data that can be  >>          09050000
  << requested is shown.                                    >>          09055000
                                                                        09060000
                                                                        09065000
  << ALLOWABLE TYPES OF READS >>                                        09070000
                                                                        09075000
  equate                                                                09080000
                                                                        09085000
    one'record'immediately        = 0                                   09090000
      << read one record immediately; may be null response >>           09095000
                                                                        09100000
   ,one'when'available            = 1                                   09105000
      << read one record when available >>                              09110000
                                                                        09115000
   ,one'continuation'record       = 2                                   09120000
      << read one continuation record when available >>                 09125000
                                                                        09130000
   ,read'continuously             = 3                                   09135000
      << read records continuously, as available >>                     09140000
                                                                        09145000
  ;                                                                     09150000
                                                                        09155000
                                                                        09160000
  << ALLOWABLE "READ" DATA TYPES >>                                     09165000
                                                                        09170000
  equate                                                                09175000
                                                                        09180000
    user'escape'seq'response      = 1                                   09185000
      << response to user's escape sequence command >>                  09190000
                                                                        09195000
   ,host'escape'seq'response      = 2                                   09200000
      << response to host's escape sequence command >>                  09205000
                                                                        09210000
   ,keyboard'input                = 8                                   09215000
      << data input from device keyboard >>                             09220000
                                                                        09225000
  ;                                                                     09230000
                                                                        09235000
                                                                        09240000
$PAGE "CIPER 'WRITE' RECORD DEFINITIONS"                                09245000
  << The following types of write data records are current- >>          09250000
  << ly defined by CIPER.  This information is included in  >>          09255000
  << the type of data field of the record header.           >>          09260000
                                                                        09265000
                                                                        09270000
  equate                                                                09275000
                                                                        09280000
    user'data'with'mask           = 0                                   09285000
      << user data with control mask invoked >>                         09290000
                                                                        09295000
   ,user'data'without'mask        = 1                                   09300000
      << user data without control mask invoked >>                      09305000
                                                                        09310000
   ,host'data                     = 2                                   09315000
      << host data (no control mask ever) >>                            09320000
                                                                        09325000
   ,display'panel'data            = 8                                   09330000
      << data for display panel (if any) >>                             09335000
                                                                        09340000
  ;                                                                     09345000
                                                                        09350000
                                                                        09355000
  << "WRITE" block label information >>                                 09360000
                                                                        09365000
  equate                                                                09370000
                                                                        09375000
    block'label'length            = 6                                   09380000
      << Block labels are six bytes long, in the following >>           09385000
      << format:                                           >>           09390000
      <<    byte 0 - Block label length                    >>           09395000
      <<    byte 1 - Reserved                              >>           09400000
      <<    bytes 2-5 Double word block number             >>           09405000
                                                                        09410000
                                                                        09415000
  ;                                                                     09420000
                                                                        09425000
                                                                        09430000
$PAGE "CIPER 'CONFIGURATION' RECORD DATA TYPE DEFINITIONS"              09435000
  << CIPER currently has two types of configuration data:   >>          09440000
  << the status mask, which indicates when, if, and what    >>          09445000
  << type(s) of status to report, and the control mask,     >>          09450000
  << which defines which set of ASCII control codes and es- >>          09455000
  << cape sequences the device should act upon.             >>          09460000
                                                                        09465000
                                                                        09470000
  equate                                                                09475000
                                                                        09480000
    status'mask                   = 0                                   09485000
      << Configures reporting of certain status types, >>               09490000
      << such as device status or environmental status >>               09495000
                                                                        09500000
   ,control'mask                  = 1                                   09505000
      << mask for control code/escape sequence processing >>            09510000
                                                                        09515000
  ;                                                                     09520000
                                                                        09525000
                                                                        09530000
  << Universal equate for logical record types which have >>            09535000
  << no particular data type(s):                          >>            09540000
                                                                        09545000
  equate                                                                09550000
                                                                        09555000
    no'data'type'used             = 0                                   09560000
                                                                        09565000
  ;                                                                     09570000
                                                                        09575000
                                                                        09580000
                                                                        09585000
                                                                        09590000
$PAGE "CIPER ENVIRONMENTAL STATUS DEFINITIONS"                          09595000
  << The following definitions are the major elements of    >>          09600000
  << the fixed portion of an environmental status report.   >>          09605000
  << The device dependent portion can be of arbitrary       >>          09610000
  << length and content, so no definition of that portion   >>          09615000
  << is given.                                              >>          09620000
                                                                        09625000
  << The most recent copy of environmental status is saved  >>          09630000
  << in the CIPER data segment, where the user program/     >>          09635000
  << spooler can retrieve it via a function 191 request.    >>          09640000
                                                                        09645000
                                                                        09650000
  equate  << single word indexes >>                                     09655000
                                                                        09660000
    block'number                  = 0                                   09665000
      << user data block number >>                                      09670000
                                                                        09675000
   ,byte'offset                   = 2                                   09680000
      << byte offset within data block >>                               09685000
                                                                        09690000
   ,checkpoint'number             = 4                                   09695000
      << device checkpoint identifier >>                                09700000
                                                                        09705000
   ,last'non'recov'checkpoint     = 6                                   09710000
      << previous checkpoint ahead of which no recovery >>              09715000
      << can be performed with this status information  >>              09720000
                                                                        09725000
   ,esb'format'number             = 8                                   09730000
      << identifies the specific format of device depen- >>             09735000
      << dent area, which follows this field             >>             09740000
                                                                        09745000
   ,device'dep'status             = 9                                   09750000
      << device dependent status portion >>                             09755000
                                                                        09760000
  ;                                                                     09765000
                                                                        09770000
  equate  << double word indexes >>                                     09775000
                                                                        09780000
    d'block'number                = 0                                   09785000
   ,d'byte'offset                 = 1                                   09790000
   ,d'checkpoint'number           = 2                                   09795000
   ,d'last'non'recov'checkpoint   = 3                                   09800000
                                                                        09805000
  ;                                                                     09810000
                                                                        09815000
                                                                        09820000
                                                                        09825000
  equate                                                                09830000
                                                                        09835000
    env'status'overhead           = 1                                   09840000
      << total space required for env status control info >>            09845000
                                                                        09850000
  ;                                                                     09855000
                                                                        09860000
                                                                        09865000
                                                                        09870000
$PAGE "CIPER DEVICE STATUS DEFINITIONS"                                 09875000
  << Device status indicates the state of the peripheral.   >>          09880000
  << It may be specifically requested from the device, or   >>          09885000
  << the device may be configured to send a status report   >>          09890000
  << if any of the information contained in the report has  >>          09895000
  << changed.  The device ALWAYS reports a powerfail.       >>          09900000
                                                                        09905000
  << The most recent copy of device status will be saved in >>          09910000
  << the CIPER data segment.  The user program/spooler can  >>          09915000
  << retrieve the information with either a device status   >>          09920000
  << function request.                                      >>          09925000
                                                                        09930000
  << Reception of a status report may cause console mes-    >>          09935000
  << sages to be generated.                                 >>          09940000
                                                                        09945000
                                                                        09950000
                                                                        09955000
  define                                                                09960000
                                                                        09965000
    peripheral'status             = 0).(0:8 #                           09970000
      << peripheral status byte - reflects current status >>            09975000
                                                                        09980000
   ,peripheral'errors             = 0).(8:8 #                           09985000
      << peripheral error occurance - cleared when read >>              09990000
                                                                        09995000
   ,self'test'code                = 1 #                                 10000000
      << contains self test information >>                              10005000
                                                                        10010000
   ,ciper'protocol'errors         = 2 #                                 10015000
      << device clears after reporting >>                               10020000
                                                                        10025000
    << status byte expansions: >>                                       10030000
                                                                        10035000
    << peripheral status: >>                                            10040000
   ,on'line                       = 0).(0:1 #                           10045000
   ,paper'out                     = 0).(1:1 #                           10050000
   ,paper'jam                     = 0).(2:1 #                           10055000
   ,platen'open                   = 0).(3:1 #                           10060000
   ,ribbon'error                  = 0).(4:1 #                           10065000
   ,self'test'failed              = 0).(6:1 #                           10070000
                                                                        10075000
    << peripheral errors: >>                                            10080000
   ,possible'data'loss            = 0).(14:1 #                          10085000
   ,power'fail                    = 0).(15:1 #                          10090000
                                                                        10095000
    << CIPER protocol errors: >>                                        10100000
   ,illegal'header'length         = 2).(0:1 #                           10105000
   ,recv'record'numbering'error   = 2).(1:1 #                           10110000
   ,illegal'creator'bit           = 2).(2:1 #                           10115000
   ,undefined'record'opcode       = 2).(3:1 #                           10120000
   ,bad'data'type                 = 2).(4:1 #                           10125000
   ,bad'esb'format'number         = 2).(5:1 #                           10130000
   ,illegal'block'label'len       = 2).(7:1 #                           10135000
   ,transport'error               = 2).(8:1 #                           10140000
   ,data'overrun                  = 2).(9:1 #                           10145000
  ;                                                                     10150000
                                                                        10155000
                                                                        10160000
  equate                                                                10165000
                                                                        10170000
    device'status'length          = 6                                   10175000
      << length of information (in bytes) >>                            10180000
                                                                        10185000
   ,device'status'size            = device'status'length + 1            10190000
      << total space required for device status (in words) >>           10195000
      << Leaves enough room for two copies (old and new) >>             10200000
      << required for comparisons.                       >>             10205000
                                                                        10210000
   ,comp'status'length            = (device'status'length+1)/2          10215000
      << length, in words, of composite status information >>           10220000
                                                                        10225000
   ,comp'status'size              = comp'status'length + 1              10230000
      << size, in words, of area required for the composite >>          10235000
      << device status information.                         >>          10240000
                                                                        10245000
  ;                                                                     10250000
                                                                        10255000
                                                                        10260000
$PAGE "CIPER JOB REPORT DEFINITIONS"                                    10265000
  << The job report will be returned at the end of a job,   >>          10270000
  << or when specifically requested via the return job re-  >>          10275000
  << port command.                                          >>          10280000
                                                                        10285000
                                                                        10290000
                                                                        10295000
  equate                                                                10300000
                                                                        10305000
    job'end'errors                = 0                                   10310000
      << Flags for certain error conditions present at end >>           10315000
      << of job                                            >>           10320000
                                                                        10325000
   ,physical'page'count           = 1                                   10330000
      << Double word count of physical pages printed during >>          10335000
      << job                                                >>          10340000
                                                                        10345000
  ;                                                                     10350000
                                                                        10355000
                                                                        10360000
  equate                                                                10365000
                                                                        10370000
    job'report'length             = 6                                   10375000
      << length of information (in bytes) >>                            10380000
                                                                        10385000
   ,job'report'size               = ((job'report'length+1)/2)+1         10390000
      << total space required for job report >>                         10395000
      << Takes into account odd sized report lengths >>                 10400000
                                                                        10405000
  ;                                                                     10410000
                                                                        10415000
                                                                        10420000
$PAGE "CIPER MISCELLANEOUS INFORMATION"                                 10425000
  << PRODUCT IDENTIFICATION AREA INFORMATION >>                         10430000
                                                                        10435000
  equate                                                                10440000
                                                                        10445000
    product'id'length             = 7                                   10450000
      << length (in bytes) of product identification info >>            10455000
                                                                        10460000
   ,product'id'size               = (product'id'length+1)/2 + 1         10465000
      << size (in words) of area reserved for product id >>             10470000
                                                                        10475000
  ;                                                                     10480000
                                                                        10485000
                                                                        10490000
                                                                        10495000
                                                                        10500000
                                                                        10505000
  << MISCELLANEOUS INFORMATION >>                                       10510000
                                                                        10515000
  define                                                                10520000
                                                                        10525000
    in'use                        = true #                              10530000
      << indicates record buffer area is not clean >>                   10535000
                                                                        10540000
   ,free                          = false #                             10545000
      << indicates record buffer area has no record >>                  10550000
                                                                        10555000
  ;                                                                     10560000
                                                                        10565000
                                                                        10570000
  << DEFINITIONS FOR SINGLE BIT EXTRACTIONS >>                          10575000
                                                                        10580000
  define                                                                10585000
                                                                        10590000
    bit'0                         = ( 0: 1) #                           10595000
   ,bit'1                         = ( 1: 1) #                           10600000
   ,bit'2                         = ( 2: 1) #                           10605000
   ,bit'3                         = ( 3: 1) #                           10610000
   ,bit'4                         = ( 4: 1) #                           10615000
   ,bit'5                         = ( 5: 1) #                           10620000
   ,bit'6                         = ( 6: 1) #                           10625000
   ,bit'7                         = ( 7: 1) #                           10630000
   ,bit'8                         = ( 8: 1) #                           10635000
   ,bit'9                         = ( 9: 1) #                           10640000
   ,bit'10                        = (10: 1) #                           10645000
   ,bit'11                        = (11: 1) #                           10650000
   ,bit'12                        = (12: 1) #                           10655000
   ,bit'13                        = (13: 1) #                           10660000
   ,bit'14                        = (14: 1) #                           10665000
   ,bit'15                        = (15: 1) #                           10670000
                                                                        10675000
  ;                                                                     10680000
                                                                        10685000
                                                                        10690000
  equate                                                                10695000
                                                                        10700000
    host                          = 0                                   10705000
      << indicates host is originator of this record >>                 10710000
                                                                        10715000
   ,device                        = 1                                   10720000
      << indicates device is originator of this record >>               10725000
                                                                        10730000
   ,blocked                       = 1                                   10735000
      << indicates blocked I/O request >>                               10740000
                                                                        10745000
   ,xlator'buff'size              = 50                                  10750000
      << size of translator escape sequence buffer(s) >>                10755000
                                                                        10760000
   ,set'bit                       = 1                                   10765000
      << Sets a single bit >>                                           10770000
                                                                        10775000
   ,clear'bit                     = 0                                   10780000
      << Clear a single bit >>                                          10785000
                                                                        10790000
   ,no'overwrite                  = 0                                   10795000
      << Used when calling get'buffer:  indicates that if >>            10800000
      << no record buffer area is available from the free >>            10805000
      << list, then return a nil pointer.                 >>            10810000
                                                                        10815000
   ,output'overwrite              = 1                                   10820000
      << Used when calling get'buffer:  indicates that if >>            10825000
      << no record buffer area is available from the free >>            10830000
      << list, then return the dedicated output buffer.   >>            10835000
                                                                        10840000
   ,input'overwrite               = 2                                   10845000
      << Used when calling get'buffer:  indicates that if >>            10850000
      << no record buffer area is available from the free >>            10855000
      << list, then return the dedicated input buffer.    >>            10860000
                                                                        10865000
                                                                        10870000
  << Calling parameters used when calling the procedures   >>           10875000
  << b08'buf'device'status and b08'buffered'env'status:    >>           10880000
                                                                        10885000
   ,buffered                      = 0                                   10890000
      << Get the copy currently in the appropriate status   >>          10895000
      << area.                                              >>          10900000
                                                                        10905000
   ,immediate                     = 1                                   10910000
      << Get a fresh copy directly from the device          >>          10915000
                                                                        10920000
   ,composite                     = 2                                   10925000
      << Get the composite device status                    >>          10930000
                                                                        10935000
  ;                                                                     10940000
                                                                        10945000
                                                                        10950000
  << TEMPORARY !!! DEFINITIONS FOR EXTERNALS >>                         10955000
                                                                        10960000
                                                               <<07425>>10965000
                                                               <<07425>>10970000
                                                               <<07425>>10975000
                                                               <<07425>>10980000
                                                               <<07425>>10985000
                                                               <<07425>>10990000
                                                                        10995000
                                                                        11000000
$PAGE "CIPER INTERNAL LOGGING DEFINITIONS"                              11005000
                                                                        11010000
  << General logging constants >>                                       11015000
                                                                        11020000
  equate                                                                11025000
                                                                        11030000
    head'entry'length             = 6                          <<07425>>11035000
      << Size (in words) of logging dst head entry >>                   11040000
                                                                        11045000
   ,log'data'length               = 38                                  11050000
      << Allow 38 words of data per log record >>                       11055000
                                                                        11060000
  ;                                                                     11065000
                                                                        11070000
                                                                        11075000
                                                                        11080000
  equate                                                                11085000
                                                                        11090000
  << First section of logging buffer is reserved for the >>             11095000
  << logging dst head entry.  This entry controls the use >>            11100000
  << of the dst, and is written to and saved in the dst  >>             11105000
  << when the dst becomes full and/or logging is completed >>           11110000
                                                                        11115000
    he'length                     = -head'entry'length                  11120000
      << length of head entry in logging buffer >>                      11125000
                                                                        11130000
   ,he'type                       = 1 + he'length                       11135000
      << head entry type >>                                             11140000
                                                                        11145000
   ,he'ldev                       = 1 + he'type                         11150000
      << backward reference to ldev associated with log >>              11155000
                                                                        11160000
   ,he'next'word                  = 1 + he'ldev                         11165000
      << next available word in current logging dst >>                  11170000
                                                                        11175000
   ,he'last'word                  = 1 + he'next'word                    11180000
      << last word of current logging dst >>                            11185000
                                                                        11190000
   ,he'wrap                    = 1 + he'last'word              <<07425>>11195000
      << link to previous dst used for logging >>                       11200000
                                                                        11205000
                                                                        11210000
                                                                        11215000
  << The rest of the logging buffer is for entry use, with >>           11220000
  << the first two words having special meaning:           >>           11225000
                                                                        11230000
   ,log'entry'length              = 1 + he'wrap                <<07425>>11235000
      << inclusive length of log entry data (in words) >>               11240000
                                                                        11245000
   ,log'entry'type                = 1 + log'entry'length                11250000
      << type of log entry -- used by analysis program >>               11255000
                                                                        11260000
   ,log'transaction               = 1 + log'entry'type         <<07425>>11265000
      << transaction sequence number of current driver call >> <<07425>>11270000
                                                               <<07425>>11275000
   ,log'entry'data                = 1 + log'transaction        <<07425>>11280000
      << base of data portion of log entry >>                           11285000
                                                                        11290000
                                                                        11295000
  << The next two items are used during initialization to  >>           11300000
  << set up the logging system.                            >>           11305000
                                                                        11310000
   ,log'buffer'size               = 1 + log'entry'data                  11315000
                                  - he'length + 1                       11320000
                                  + log'data'length                     11325000
      << Size of buffer to allocate in CIPER data segment >>            11330000
                                                                        11335000
   ,log'dst'size                  = 30720                      <<07425>>11340000
      << Size of dst (in words) to allocate for logging >>              11345000
                                                               <<07425>>11350000
   ,log'overhead                  = log'entry'data + 1         <<07425>>11355000
      << number of non-data words in log entry >>              <<07425>>11360000
                                                                        11365000
;                                                                       11370000
                                                                        11375000
                                                                        11380000
  << Logging event types (as defined so far).  Permissable >>           11385000
  << range is 1 to 15.  Zero defaults to mean all events.  >>           11390000
                                                                        11395000
  equate                                                                11400000
                                                                        11405000
    all'events                    = 0                                   11410000
      << Enable/disable all events defined >>                           11415000
                                                                        11420000
   ,le'driver'entry               = 1                          <<07425>>11425000
      << Driver entry parameters and time >>                   <<07425>>11430000
                                                               <<07425>>11435000
   ,le'driver'exit                = 2                          <<07425>>11440000
      << Driver completion status and time >>                  <<07425>>11445000
                                                               <<07425>>11450000
   ,le'device'clear               = 3                          <<07425>>11455000
      << Records attempted device clears, with recursion >>    <<07425>>11460000
      << level and device clear number sent >>                 <<07425>>11465000
                                                               <<07425>>11470000
   ,le'xmit'record                = 4                          <<07425>>11475000
      << Records length and header info of records sent >>     <<07425>>11480000
                                                               <<07425>>11485000
   ,le'recv'record                = 5                          <<07425>>11490000
      << Records length and header info of records recv'd >>   <<07425>>11495000
                                                               <<07425>>11500000
   ,le'device'status              = 6                          <<07425>>11505000
      << Records copy of device status report recv'd >>        <<07425>>11510000
                                                               <<07425>>11515000
   ,le'esb                        = 7                          <<07425>>11520000
      << Records copy of ENVIRONMENTAL STATUS BLOCK received >><<07425>>11525000
                                                               <<07425>>11530000
   ,le'job'report                 = 8                          <<07425>>11535000
      << Records copy of JOB REPORT received >>                <<07425>>11540000
                                                                        11545000
   ,event'type'9                  = 9                                   11550000
      << Undefined >>                                                   11555000
                                                                        11560000
   ,event'type'10                 = 10                                  11565000
      << Undefined >>                                                   11570000
                                                                        11575000
   ,event'type'11                 = 11                                  11580000
      << Undefined >>                                                   11585000
                                                                        11590000
   ,event'type'12                 = 12                                  11595000
      << Undefined >>                                                   11600000
                                                                        11605000
   ,event'type'13                 = 13                                  11610000
      << Undefined >>                                                   11615000
                                                                        11620000
   ,event'type'14                 = 14                                  11625000
      << Undefined >>                                                   11630000
                                                                        11635000
   ,event'type'15                 = 15                                  11640000
      << Undefined >>                                                   11645000
                                                                        11650000
  ;                                                                     11655000
                                                                        11660000
                                                                        11665000
  << Log entry type codes.  Used by reduction program to >>             11670000
  << sort events by type.                                >>             11675000
                                                                        11680000
  equate                                                                11685000
                                                                        11690000
    head'entry'type               = 0                                   11695000
      << Head entry of logging dst. >>                                  11700000
                                                                        11705000
  ;                                                                     11710000
                                                                        11715000
$PAGE                                                          <<07425>>11720000
COMMENT                                                        <<07425>>11725000
                                                               <<07425>>11730000
  PURPOSE:                                                     <<07425>>11735000
                                                               <<07425>>11740000
    This subroutine will return the address of the logging     <<07425>>11745000
    buffer in the CIPER data segment.                          <<07425>>11750000
                                                               <<07425>>11755000
                                                               <<07425>>11760000
  INPUT PARAMETERS:                                            <<07425>>11765000
                                                               <<07425>>11770000
    LOG'BUFFER, which is a dummy parameter used solely as      <<07425>>11775000
      a scratch variable.                                      <<07425>>11780000
                                                               <<07425>>11785000
                                                               <<07425>>11790000
  OUTPUT PARAMETERS:                                           <<07425>>11795000
                                                               <<07425>>11800000
    GET'LOG'BUFFER, which returns a DB relative address to     <<07425>>11805000
      the logging buffer.                                      <<07425>>11810000
                                                               <<07425>>11815000
                                                               <<07425>>11820000
  SIDE-EFFECTS:                                                <<07425>>11825000
                                                               <<07425>>11830000
    None.                                                      <<07425>>11835000
                                                               <<07425>>11840000
                                                               <<07425>>11845000
  SPECIAL CONSIDERATIONS:                                      <<07425>>11850000
                                                               <<07425>>11855000
    None.                                                      <<07425>>11860000
                                                               <<07425>>11865000
                                                               <<07425>>11870000
  CHANGE HISTORY:                                              <<07425>>11875000
                                                               <<07425>>11880000
    As issued.                                                 <<07425>>11885000
                                                               <<07425>>11890000
;                                                              <<07425>>11895000
                                                               <<07425>>11900000
define                                                         <<07425>>11905000
                                                               <<07425>>11910000
  declare'get'log'buffer =                                     <<07425>>11915000
                                                               <<07425>>11920000
logical subroutine get'log'buffer(log'buffer);                 <<07425>>11925000
  value log'buffer;  integer pointer log'buffer;               <<07425>>11930000
begin                                                          <<07425>>11935000
  @log'buffer:=cb'info(logging'buffer)                         <<07425>>11940000
               + cb'info(cds'area'base);                       <<07425>>11945000
  get'log'buffer:=@log'buffer+log'buffer;                      <<07425>>11950000
end #                                                          <<07425>>11955000
                                                               <<07425>>11960000
;                                                              <<07425>>11965000
                                                               <<07425>>11970000
$PAGE                                                          <<07425>>11975000
COMMENT                                                        <<07425>>11980000
                                                               <<07425>>11985000
  PURPOSE:                                                     <<07425>>11990000
                                                               <<07425>>11995000
    This subroutine will move the head entry from the current  <<07425>>12000000
    logging dst into the base of the logging buffer in the     <<07425>>12005000
    CIPER data segment.                                        <<07425>>12010000
                                                               <<07425>>12015000
                                                               <<07425>>12020000
  INPUT PARAMETERS:                                            <<07425>>12025000
                                                               <<07425>>12030000
    LOG'BUFFER, which points to the logging buffer in the      <<07425>>12035000
      CIPER data segment.                                      <<07425>>12040000
                                                               <<07425>>12045000
                                                               <<07425>>12050000
  OUTPUT PARAMETERS:                                           <<07425>>12055000
                                                               <<07425>>12060000
    None.                                                      <<07425>>12065000
                                                               <<07425>>12070000
                                                               <<07425>>12075000
  SIDE-EFFECTS:                                                <<07425>>12080000
                                                               <<07425>>12085000
    None.                                                      <<07425>>12090000
                                                               <<07425>>12095000
                                                               <<07425>>12100000
  SPECIAL CONSIDERATIONS:                                      <<07425>>12105000
                                                               <<07425>>12110000
    None.                                                      <<07425>>12115000
                                                               <<07425>>12120000
  CHANGE HISTORY:                                              <<07425>>12125000
                                                               <<07425>>12130000
    As issued.                                                 <<07425>>12135000
                                                               <<07425>>12140000
;                                                              <<07425>>12145000
                                                               <<07425>>12150000
define                                                         <<07425>>12155000
                                                               <<07425>>12160000
  declare'get'head'entry =                                     <<07425>>12165000
                                                               <<07425>>12170000
subroutine get'head'entry(log'buffer);                         <<07425>>12175000
  value log'buffer;  integer pointer log'buffer;               <<07425>>12180000
begin                                                          <<07425>>12185000
  @log'buffer := cb'info(logging'buffer)                       <<07425>>12190000
               + cb'info(cds'area'base);                       <<07425>>12195000
  mfds(log'buffer,cb'info(logging'dst),0,1);                   <<07425>>12200000
  mfds(log'buffer(1),cb'info(logging'dst),1,log'buffer-1);     <<07425>>12205000
end #                                                          <<07425>>12210000
                                                               <<07425>>12215000
;                                                              <<07425>>12220000
                                                               <<07425>>12225000
$PAGE                                                          <<07425>>12230000
COMMENT                                                        <<07425>>12235000
                                                               <<07425>>12240000
  PURPOSE:                                                     <<07425>>12245000
                                                               <<07425>>12250000
    This subroutine will move the head entry from the logging  <<07425>>12255000
    buffer of the CIPER data segment into the base of the      <<07425>>12260000
    current logging dst.                                       <<07425>>12265000
                                                               <<07425>>12270000
                                                               <<07425>>12275000
  INPUT PARAMETERS:                                            <<07425>>12280000
                                                               <<07425>>12285000
    LOG'BUFFER, which points to the logging buffer in the      <<07425>>12290000
      CIPER data segment.                                      <<07425>>12295000
                                                               <<07425>>12300000
                                                               <<07425>>12305000
  OUTPUT PARAMETERS:                                           <<07425>>12310000
                                                               <<07425>>12315000
    None.                                                      <<07425>>12320000
                                                               <<07425>>12325000
                                                               <<07425>>12330000
  SIDE-EFFECTS:                                                <<07425>>12335000
                                                               <<07425>>12340000
    None.                                                      <<07425>>12345000
                                                               <<07425>>12350000
                                                               <<07425>>12355000
  SPECIAL CONSIDERATIONS:                                      <<07425>>12360000
                                                               <<07425>>12365000
    None.                                                      <<07425>>12370000
                                                               <<07425>>12375000
  CHANGE HISTORY:                                              <<07425>>12380000
                                                               <<07425>>12385000
    As issued.                                                 <<07425>>12390000
                                                               <<07425>>12395000
;                                                              <<07425>>12400000
                                                               <<07425>>12405000
define                                                         <<07425>>12410000
                                                               <<07425>>12415000
  declare'put'head'entry =                                     <<07425>>12420000
                                                               <<07425>>12425000
subroutine put'head'entry(log'buffer);                         <<07425>>12430000
  value log'buffer;  integer pointer log'buffer;               <<07425>>12435000
begin                                                          <<07425>>12440000
  @log'buffer := cb'info(logging'buffer)                       <<07425>>12445000
               + cb'info(cds'area'base);                       <<07425>>12450000
  mtds(cb'info(logging'dst),0,log'buffer,log'buffer);          <<07425>>12455000
end #                                                          <<07425>>12460000
                                                               <<07425>>12465000
;                                                              <<07425>>12470000
                                                               <<07425>>12475000
$PAGE                                                          <<07425>>12480000
COMMENT                                                        <<07425>>12485000
                                                               <<07425>>12490000
  PURPOSE:                                                     <<07425>>12495000
                                                               <<07425>>12500000
    This subroutine will move information from the logging     <<07425>>12505000
    buffer of the CIPER data segment to the next available     <<07425>>12510000
    location in the current logging dst.                       <<07425>>12515000
                                                               <<07425>>12520000
                                                               <<07425>>12525000
  INPUT PARAMETERS:                                            <<07425>>12530000
                                                               <<07425>>12535000
    LOG'BUFFER, which points to the logging buffer in the      <<07425>>12540000
      CIPER data segment.                                      <<07425>>12545000
                                                               <<07425>>12550000
                                                               <<07425>>12555000
  OUTPUT PARAMETERS:                                           <<07425>>12560000
                                                               <<07425>>12565000
    None.                                                      <<07425>>12570000
                                                               <<07425>>12575000
                                                               <<07425>>12580000
  SIDE-EFFECTS:                                                <<07425>>12585000
                                                               <<07425>>12590000
    Can cause a new logging data segment to be allocated,      <<07425>>12595000
    linking the new and old together in a linked list.         <<07425>>12600000
                                                               <<07425>>12605000
                                                               <<07425>>12610000
  SPECIAL CONSIDERATIONS:                                      <<07425>>12615000
                                                               <<07425>>12620000
    None.                                                      <<07425>>12625000
                                                               <<07425>>12630000
  CHANGE HISTORY:                                              <<07425>>12635000
                                                               <<07425>>12640000
    As issued.                                                 <<07425>>12645000
                                                               <<07425>>12650000
;                                                              <<07425>>12655000
                                                               <<07425>>12660000
define                                                         <<07425>>12665000
                                                               <<07425>>12670000
  declare'put'le =                                             <<07425>>12675000
subroutine put'le(lb,len);                                     <<07425>>12680000
  value lb,len;  integer pointer lb;  integer len;             <<07425>>12685000
begin                                                          <<07425>>12690000
  len := len + log'overhead;  lb(log'entry'length) := len;     <<07425>>12695000
  lb(len-1) := len;                                            <<07425>>12700000
  lb(log'transaction) := cb'info(dvr'seq);                     <<07425>>12705000
  if (lb(he'next'word) + len) > lb(he'last'word) then          <<07425>>12710000
    begin                                                      <<07425>>12715000
      lb(he'next'word) := head'entry'length;                   <<07425>>12720000
      lb(he'wrap) := -1;                                       <<07425>>12725000
    end;                                                       <<07425>>12730000
  mtds( cb'info(logging'dst), lb(he'next'word), lb, len );     <<07425>>12735000
  lb(he'next'word) := lb(he'next'word) + len;                  <<07425>>12740000
end #                                                          <<07425>>12745000
                                                               <<07425>>12750000
;                                                              <<07425>>12755000
                                                               <<07425>>12760000
$PAGE                                                          <<07425>>12765000
                                                               <<07425>>12770000
COMMENT                                                        <<07425>>12775000
                                                               <<07425>>12780000
  PURPOSE:                                                     <<07425>>12785000
                                                               <<07425>>12790000
    This subroutine will check the event map of cb'info to de- <<07425>>12795000
    termine if logging has been enabled for this event.  If it <<07425>>12800000
    has, the routine will return true.  False is returned      <<07425>>12805000
    otherwise.                                                 <<07425>>12810000
                                                               <<07425>>12815000
                                                               <<07425>>12820000
  INPUT PARAMETERS:                                            <<07425>>12825000
                                                               <<07425>>12830000
    EVENT, which indicates the event to check.  Valid events   <<07425>>12835000
      range from 1 to 15 (will be expanded later).  Any other  <<07425>>12840000
      value produces an immediate return.                      <<07425>>12845000
                                                               <<07425>>12850000
                                                               <<07425>>12855000
  OUTPUT PARAMETERS:                                           <<07425>>12860000
                                                               <<07425>>12865000
    EVENT'ENABLED, which is the function return of the subrou- <<07425>>12870000
      tine.  If the particular event has been enabled, a value <<07425>>12875000
      of true is returned.  Otherwise, a value of false is re- <<07425>>12880000
      turned.                                                  <<07425>>12885000
                                                               <<07425>>12890000
                                                               <<07425>>12895000
  SIDE-EFFECTS:                                                <<07425>>12900000
                                                               <<07425>>12905000
    None.                                                      <<07425>>12910000
                                                               <<07425>>12915000
                                                               <<07425>>12920000
  SPECIAL CONSIDERATIONS:                                      <<07425>>12925000
                                                               <<07425>>12930000
    None.                                                      <<07425>>12935000
                                                               <<07425>>12940000
                                                               <<07425>>12945000
  CHANGE HISTORY:                                              <<07425>>12950000
                                                               <<07425>>12955000
                                                               <<07425>>12960000
;                                                              <<07425>>12965000
                                                               <<07425>>12970000
define                                                         <<07425>>12975000
                                                               <<07425>>12980000
  declare'event'enabled =                                      <<07425>>12985000
                                                               <<07425>>12990000
logical subroutine event'enabled(event);                       <<07425>>12995000
  value event;  integer event;                                 <<07425>>13000000
begin                                                          <<07425>>13005000
  if event <= 0 or event > 15 then                             <<07425>>13010000
    begin                                                      <<07425>>13015000
      event'enabled := false;                                  <<07425>>13020000
    end                                                        <<07425>>13025000
  else                                                         <<07425>>13030000
    begin                                                      <<07425>>13035000
      x := event;                                              <<07425>>13040000
      event := %40000;                                         <<07425>>13045000
      while dxbz do event := event & csr(1);                   <<07425>>13050000
      event:=integer(logical(event) lor %100000);              <<07425>>13055000
      event'enabled:=integer                                   <<07425>>13060000
        (logical(cb'info(event'map)) land logical(event)) > 0; <<07425>>13065000
    end;                                                       <<07425>>13070000
end #                                                          <<07425>>13075000
                                                               <<07425>>13080000
;                                                              <<07425>>13085000
                                                               <<07425>>13090000
                                                                        13095000
                                                                        13100000
$PAGE "CIPER MESSAGE CATALOG DEFINITIONS"                               13105000
  << Definition of CIPER message catalog set number and >>              13110000
  << message text numbers.                              >>              13115000
                                                                        13120000
  equate                                                                13125000
                                                                        13130000
    ciper'set                     = 28                                  13135000
      << message set of CIPER error messages >>                         13140000
                                                                        13145000
   ,not'ready'msg                 = 1                                   13150000
      << ldev not ready >>                                              13155000
                                                                        13160000
   ,power'up'msg                  = 2                                   13165000
      << device powered up or reset >>                                  13170000
                                                                        13175000
   ,off'line'msg                  = 3                                   13180000
      << device has been placed off-line >>                             13185000
                                                                        13190000
   ,on'line'msg                   = 4                                   13195000
      << device has been placed on-line >>                              13200000
                                                                        13205000
   ,paper'out'msg                 = 5                                   13210000
      << device reports out of paper >>                                 13215000
                                                                        13220000
   ,paper'jam'msg                 = 6                                   13225000
      << device reports paper jam >>                                    13230000
                                                                        13235000
   ,platen'open'msg               = 7                                   13240000
      << device reports platen is open >>                               13245000
                                                                        13250000
   ,ribbon'error'msg              = 8                                   13255000
      << to be assigned >>                                              13260000
                                                                        13265000
   ,self'test'msg                 = 9                                   13270000
      << device reports self test failure >>                            13275000
                                                                        13280000
   ,msg'illegal'header'length     = 10                                  13285000
      << device reports illegal record header length >>                 13290000
                                                                        13295000
   ,msg'record'sequence'error     = 11                                  13300000
      << device reports sequence error in record sequence >>            13305000
      << number                                           >>            13310000
                                                                        13315000
   ,msg'illegal'creator'of'record = 12                                  13320000
      << device received a record with an invalid creator >>            13325000
      << bit in the record header                         >>            13330000
                                                                        13335000
   ,msg'undef'record'opcode       = 13                                  13340000
      << device received a record with an invalid opcode  >>            13345000
      << field in the record header                       >>            13350000
                                                                        13355000
   ,msg'undef'data'type           = 14                                  13360000
      << device received a record with an invalid data    >>            13365000
      << type field in the record header                  >>            13370000
                                                                        13375000
   ,msg'bad'ESB'format'number     = 15                                  13380000
      << device received a silent run command with an in- >>            13385000
      << valid ESB format number in it.                   >>            13390000
                                                                        13395000
   ,msg'bad'block'label'length    = 17                                  13400000
      << device received a record marked 'start of block' >>            13405000
      << that had an invalid block label length parameter >>            13410000
                                                                        13415000
   ,msg'transport'error           = 18                                  13420000
      << device's transport service interface reported an >>            13425000
      << error it could not recover from                  >>            13430000
                                                                        13435000
   ,msg'data'overrun              = 19                                  13440000
      << device was overrun by data it could not accept   >>            13445000
      << due to lack of buffer space                      >>            13450000
                                                                        13455000
   ,msg'data'lost                 = 20                                  13460000
      << device reports loss of data for some unknown     >>            13465000
      << reason                                           >>            13470000
                                                                        13475000
   ,shutdown'msg                  = 30                                  13480000
      << used when cpr'shutdown is called >>                            13485000
                                                                        13490000
  ;                                                                     13495000
                                                                        13500000
$PAGE "CIPER MISCELLANEOUS #2"                                          13505000
                                                                        13510000
                                                                        13515000
                                                                        13520000
  << DEFINITIONS OF SYSTEM GLOBAL INFORMATION >>                        13525000
                                                                        13530000
  define                                                                13535000
                                                                        13540000
    sysdb                         = 512D #                              13545000
      << absolute address of system global >>                           13550000
                                                                        13555000
  ;                                                                     13560000
                                                                        13565000
                                                                        13570000
  equate                                                                13575000
                                                                        13580000
    sysdb'                        = 512                                 13585000
      << single word equivalence of sysdb >>                            13590000
                                                                        13595000
   ,sysdb'sbuf'base               = sysdb' + 6                          13600000
      << contains sysdb relative address of system >>                   13605000
      << buffer table                              >>                   13610000
                                                                        13615000
   ,sysdb'ioq'base                = sysdb' + 5                          13620000
                                                               <<07425>>13625000
                                                               <<07425>>13630000
                                                               <<07425>>13635000
   ,sys'buff'size                 = 128                                 13640000
      << size in words of system buffer (excluding link) >>             13645000
                                                                        13650000
  ;                                                                     13655000
                                                                        13660000
                                                                        13665000
  << DEFINITION OF SYSTEM DATA SEGMENTS >>                              13670000
                                                                        13675000
  equate                                                                13680000
                                                                        13685000
    sbuf'dst                      = %10                                 13690000
      << data segment number of system buffer table >>                  13695000
                                                                        13700000
      ;                                                        <<07425>>13705000
                                                               <<07425>>13710000
                                                               <<07425>>13715000
                                                               <<07425>>13720000
                                                                        13725000
  <<ciper intrinsics>>                                                  13730000
$PAGE "INTRINSICS"                                                      13735000
                                                                        13740000
                                                                        13745000
intrinsic                                                               13750000
          debug                                                         13755000
;                                                                       13760000
                                                                        13765000
  <<ciper external procedure declarations>>                             13770000
integer procedure getioq(type);                                         13775000
  value                  type ;                                         13780000
  integer                type ;                                         13785000
  option external, privileged, uncallable;                              13790000
                                                                        13795000
                                                                        13800000
procedure returnsysbuf(index);                                          13805000
  value                index ;                                          13810000
  integer              index ;                                          13815000
  option external, privileged, uncallable;                              13820000
$PAGE "EXTERNAL PROCEDURE: EXCHANGEDB"                                  13825000
logical procedure exchangeDB(destination'dseg);                         13830000
value                        destination'dseg ;                         13835000
integer                      destination'dseg ;                         13840000
option external, privileged, uncallable;                                13845000
                                                                        13850000
COMMENT                                                                 13855000
                                                                        13860000
The procedure  exchangeDB is called to put  DB at the base of a         13865000
data segment  or to return DB  to the caller's  stack DB.   The         13870000
destination data  segment number is supplied as  a parameter if         13875000
not returning tothe stack.  If returning to the stack, supply 0         13880000
as the parameter.                                                       13885000
                                                                        13890000
exchangeDB returns the DST number of where DB was (0 if stack).         13895000
This value  may be  saved  and  returned  on  the next  call to         13900000
exchangeDB to restore the previous enviorment.                          13905000
;                                                                       13910000
                                                                        13915000
$PAGE "EXTERNAL PROCEDURES: GETDATASEG & GETDATASEGC"                   13920000
integer procedure getdataseg(memsize, vdsize);                          13925000
value                        memsize, vdsize ;                          13930000
integer                      memsize, vdsize ;                          13935000
option external, privileged, uncallable;                                13940000
                                                                        13945000
integer procedure getdatasegc(memsize, vdsize);                         13950000
value                         memsize, vdsize ;                         13955000
integer                       memsize, vdsize ;                         13960000
option external, privileged, uncallable;                                13965000
                                                                        13970000
COMMENT                                                                 13975000
                                                                        13980000
This function  is called  to create  an extra  data  segment or         13985000
stack.   A DST entry and VDS are allocated and the DST entry is         13990000
initialized to  an absent  state.   The entry  point for  stack         13995000
allocation is getstack.  The entry point to initialize the data         14000000
segment to 0's is getdatasegc.                                          14005000
                                                                        14010000
The DST number is returned.                                             14015000
;                                                                       14020000
                                                                        14025000
$PAGE "EXTERNAL PROCEDURE: GETSIR"                                      14030000
integer procedure getsir(sir);                                          14035000
value                    sir ;                                          14040000
integer                  sir ;                                          14045000
option external, privileged, uncallable;                                14050000
                                                                        14055000
COMMENT                                                                 14060000
                                                                        14065000
getsir is called to obtain exclusive access to a resource which         14070000
is protected by the queueing semaphore passed as the parameter.         14075000
If the sir is busy, the process is queued by priority through a         14080000
doubly linked  list strung through PCB entries.   If the holder         14085000
of the resource is of less  urgent priority than the requestor,         14090000
the holder's  priority is temporarily  bumped until he releases         14095000
the resource.                                                           14100000
                                                                        14105000
The return value indicates  whether the process already holds a         14110000
sir,  and  whether  the  caller  already  holds  the  sir  it's         14115000
currently  requesting.   This value should be  saved and passed         14120000
along to relsir so that proper accounting can be maintained.            14125000
                                                                        14130000
(getsir = 1) := process already held some sir.                          14135000
(getsir = 3) := process already holds the sir its requesting.           14140000
(getsir = 0) := process is acquiring its first sir.                     14145000
;                                                                       14150000
                                                                        14155000
$PAGE "EXTERNAL PROCEDURE: P'ATTACHIO"                                  14160000
                                                                        14165000
double procedure p'attachio(ldev, qmisc, dstx, addr, fnct,              14170000
                 cnt, p1, p2, flags,                           <<04540>>14175000
                 extbase, extsize );                           <<04540>>14180000
                                                                        14185000
value                       ldev, qmisc, dstx, addr, fnct,              14190000
                 cnt, p1, p2, flags,                           <<04540>>14195000
                 extbase, extsize ;                            <<04540>>14200000
                                                                        14205000
integer                     ldev, qmisc, dstx, addr, fnct,              14210000
                           cnt, p1, p2, flags, extsize ;       <<04540>>14215000
                                                               <<04540>>14220000
double                     extbase ;                           <<04540>>14225000
                                                               <<04540>>14230000
option external, privileged, variable;                         <<04540>>14235000
                                                                        14240000
                                                                        14245000
COMMENT                                                                 14250000
                                                                        14255000
Purpose:  This procedure constructs a physical IOQ element and          14260000
links it to the appropriate device queue. If this is the first          14265000
element in the queue or the request specifies preemption,  the          14270000
monitor is  called to  initiate the  operation.   For  blocked          14275000
requests,  the monitor may  be recalled by  p'attachio after a          14280000
"wait" if  the request  is not  completed  when  the caller is          14285000
awoken.                                                                 14290000
                                                                        14295000
     If not IOQ elements are available, impedable requests are          14300000
suspended until  an IOQ element becomes  available.   Requests          14305000
which specify not impedable are not  "waited"  for any reason.          14310000
class of device is called.                                              14315000
                                                                        14320000
Input:                                                                  14325000
ldev :=   Logical device number to which the IO is destined.            14330000
                                                                        14335000
qmisc :=  Miscellaneous  parameter  specified for  the device.          14340000
          If not specified must be zero.                                14345000
                                                                        14350000
dstx :=   DST  number of data segment.  If zero then specifies          14355000
          that addr is DB relative to the callers stack.  Must          14360000
          be zero if system buffers is specified.                       14365000
                                                                        14370000
addr :=   If  FLAGS.(12:1)  =  1  then  this is an  index to a          14375000
          system  buffer.  If FLAGS.(12:1) =  0 then ADDR is a          14380000
          relative address within data segment DSTX.                    14385000
                                                                        14390000
fnct :=   Function code:  device defined but usually:                   14395000
                                                                        14400000
          0 = Read                                                      14405000
          1 = Write                                                     14410000
          2 = Open file                                                 14415000
          3 = Close file                                                14420000
          4 = Close device                                              14425000
                                                                        14430000
cnt :=    Data transfer count:                                          14435000
                                                                        14440000
          If CNT > 0 then CNT value is a word count.  If CNT <          14445000
          0 then CNT value is a byte count.                             14450000
                                                                        14455000
p1 :=     Parameter 1,  device dependent.                               14460000
                                                                        14465000
p2 :=     Parameter 2,  device dependent.                               14470000
extbase := Logical sector number of current file system        <<04540>>14475000
           extent (disc only).                                 <<04540>>14480000
                                                               <<04540>>14485000
extsize := Number of sectors in current file system extent.    <<04540>>14490000
                                                               <<04540>>14495000
$PAGE                                                                   14500000
flags :=  Bit word.  Definitions are:                                   14505000
                                                                        14510000
.( 0:4)   Control and specification flags:                              14515000
                                                                        14520000
          0 = unknown                                                   14525000
          1 = file system                                               14530000
          2 = spooler                                                   14535000
         3 = directory                                         <<04540>>14540000
         4-15 various file system (see P'ATTACHIO)             <<04540>>14545000
                                                                        14550000
.( 4:3)   0   Reserved. Not used.                                       14555000
                                                                        14560000
.( 7:2)   Premption flags.                                              14565000
                                                                        14570000
          1 = soft premption                                            14575000
          2 = hard premption                                            14580000
                                                                        14585000
.( 9:1)   0   Reserved. Not used.                                       14590000
                                                                        14595000
.(10:1)   Special  request.   Device  defined.   If  set  then          14600000
          handling is to be applied to this request.                    14605000
                                                                        14610000
.(11:1)   If set then this is a diagnostic request.                     14615000
                                                                        14620000
.(12:1)   System  buffer  flag.   If set the  ADDR is an index          14625000
          relative  to  the  SBUF  table.   For  devices which          14630000
          support chaining the data is transferred to and from          14635000
          a  set  of chained buffers, up  to a maximum of 1024          14640000
          words.   IF  clear  then  ADDR  is  a  data  segment          14645000
          relative address.                                             14650000
                                                                        14655000
.(13:3)   Request type:                                                 14660000
                                                                        14665000
          0  = Unblocked, no wake on completion.  Impede if no          14670000
              LIOQ element is available.                                14675000
                                                                        14680000
          1  = Blocked.  Caller is  to be waited until request          14685000
              is completed.                                             14690000
                                                                        14695000
          2   =   Unblocked,   wake  caller  when  request  is          14700000
              completed.  impede if no LIOQ available.                  14705000
                                                                        14710000
          3  =  Unblocked  and no process  is to be associated          14715000
              with this request.  Impede if no LIOQ available.          14720000
                                                                        14725000
          4  =  Unblocked,  no  wake on completion  but do not          14730000
              impede if no LIOQ available.                              14735000
                                                                        14740000
          5 = Reserved.                                                 14745000
                                                                        14750000
          6  = Unblocked, wake on completion but do not impede          14755000
              if no LIOQ is available.                                  14760000
                                                                        14765000
          7  =  Unblocked  and no process  is to be associated          14770000
              with  this request but do  not impede if no LIOQ          14775000
              available.                                                14780000
                                                                        14785000
$PAGE                                                                   14790000
Output:                                                                 14795000
p'attachio  :=  a double word value  which may contain several          14800000
          different pieces of information as decribed below:            14805000
                                                                        14810000
                                                                        14815000
                           Blocked                                      14820000
                           -------                                      14825000
                                                                        14830000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  14835000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14840000
 S-1  |                       |  Qualifying  |General |        <<07425>>14845000
      |                       |    Status    | Status |        <<07425>>14850000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14855000
 S-0  |               Transmission Log                |                 14860000
      |               /Control Returns                |                 14865000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14870000
                                                                        14875000
                    Unblocked (IO system)                               14880000
                    ---------------------                               14885000
                                                                        14890000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  14895000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14900000
 S-1  | 0| 0| 0|         IOQ Index of request         |                 14905000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14910000
 S-0  |                       0                       |                 14915000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14920000
                                                                        14925000
                     Unblocked (DISC IO)                                14930000
                     -------------------                                14935000
                                                                        14940000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  14945000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14950000
 S-1  | 1| 0| 0|      Disk Request Table Pointer      |                 14955000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14960000
 S-0  |                       0                       |                 14965000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 14970000
                                                                        14975000
                    Unblocked (CS devices)                              14980000
                    ----------------------                              14985000
                                                                        14990000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  14995000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 15000000
 S-1  | 0| 1| 0|         ?????????????????????        |                 15005000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 15010000
 S-0  |                       0                       |                 15015000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 15020000
                                                                        15025000
$PAGE                                                                   15030000
                    Unblocked (CIPER IO)                                15035000
                    --------------------                                15040000
                                                                        15045000
Note  that  CIPER  logical IOQ is  included here for reference          15050000
only.   The first implementation of CIPER does not include the          15055000
use of LIOQ's.  The second release of CIPER will, however, use          15060000
this structure.                                                         15065000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  15070000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 15075000
 S-1  | 0| 0| 1|    Logical IOQ number of request     |                 15080000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 15085000
 S-0  |                       0                       |                 15090000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 15095000
                                                                        15100000
                                                                        15105000
  Control Returns :=                                                    15110000
                                                                        15115000
  Disk Request Table Pointer :=                                         15120000
                                                                        15125000
  General Status :=                                                     15130000
                                                                        15135000
  IOQ index of request :=                                               15140000
                                                                        15145000
  Logical IOQ Number of request :=                                      15150000
                                                                        15155000
  PCB Number :=                                                         15160000
                                                                        15165000
  Qualifing Status :=                                                   15170000
                                                                        15175000
  Transmission log :=                                                   15180000
     If CNT > 0 then CNT value is a word count.                         15185000
     If CNT < 0 then CNT value is a byte count.                         15190000
     This is the same as the CNT parameter of ATTACHIO.                 15195000
                                                                        15200000
The  IOQ index/number returned above  is used as the parameter          15205000
to IOSTATUS to determine the completion status of the request.          15210000
If  the  request type in FLAGS  specified that this request is          15215000
not  impedable  then the IOQ index/LIOQ  number return will be          15220000
zero if no IOQ/LIOQ elements are available.                             15225000
                                                                        15230000
For type 3 requests, if ADDR is not zero then it is assumed to          15235000
be a system buffer index.  At the completion of a request, the          15240000
system  buffer(s) pointed to by ADDR  are returned to the free          15245000
list by the I/O system.                                                 15250000
;                                                                       15255000
                                                                        15260000
$PAGE "EXTERNAL PROCEDURE: RELDATASEG"                                  15265000
procedure reldataseg(dseg);                                             15270000
value                dseg ;                                             15275000
integer              dseg ;                                             15280000
option external, privileged, uncallable;                                15285000
                                                                        15290000
COMMENT                                                                 15295000
                                                                        15300000
This function is called to return resources of a stack of extra         15305000
data segment.                                                           15310000
;                                                                       15315000
                                                                        15320000
$PAGE "EXTERNAL PROCEDURE: RELSIR"                                      15325000
procedure relsir(sir, savedvalue);                                      15330000
value            sir, savedvalue ;                                      15335000
integer          sir, savedvalue ;                                      15340000
option external, privileged, uncallable;                                15345000
                                                                        15350000
COMMENT                                                                 15355000
                                                                        15360000
relsir  releases  the  access   lock  to  the  system  resource         15365000
protected by the queueing semaphore passed as a parameter.  The         15370000
savedvalue returned  from getsir is  passed in  as a parameter,         15375000
and is used to determine if the process had nested calls to the         15380000
same sir  (in which  case the  sir  lock  is not released)  and         15385000
whether the process is releasing its last sir (in which case it         15390000
can field  nasty  pseudo-interrupts  which  could result in the         15395000
process being aborted).                                                 15400000
                                                                        15405000
The resource  is given to the head  of the sir queue,  which is         15410000
the most urgent  process waiting on the  sir due to the queue's         15415000
priority structure.                                                     15420000
                                                                        15425000
If the  process  had its  priority  bumped due  to more  urgent         15430000
processes queueing for the resource, the next rescheduling will         15435000
put it back where it belongs.                                           15440000
;                                                                       15445000
                                                                        15450000
$PAGE "EXTERNAL PROCEDURE:  SETCRITICAL"                       <<04422>>15455000
logical procedure setcritical;                                 <<04422>>15460000
                                                               <<04422>>15465000
  option external, privileged, uncallable;                     <<04422>>15470000
                                                               <<04422>>15475000
COMMENT                                                        <<04422>>15480000
                                                               <<04422>>15485000
  Sets the critical bit in the PCB which prevents the current  <<04422>>15490000
process from being aborted.  It returns a value which          <<04422>>15495000
indicates whether the process was already critical.            <<04422>>15500000
                                                               <<04422>>15505000
;                                                              <<04422>>15510000
$PAGE "EXTERNAL PROCEDURE:  RESETCRITICAL"                     <<04422>>15515000
procedure resetcritical( old'critical'value );                 <<04422>>15520000
                                                               <<04422>>15525000
  value                  old'critical'value  ;                 <<04422>>15530000
                                                               <<04422>>15535000
  logical                old'critical'value  ;                 <<04422>>15540000
                                                               <<04422>>15545000
  option external, privileged, uncallable    ;                 <<04422>>15550000
                                                               <<04422>>15555000
                                                               <<04422>>15560000
COMMENT                                                        <<04422>>15565000
                                                               <<04422>>15570000
  Restores the process to the abortable state unless nested    <<04422>>15575000
calls to setcritical have been made.                           <<04422>>15580000
                                                               <<04422>>15585000
;                                                              <<04422>>15590000
$PAGE "EXTERNAL PROCEDURE: RESETDB"                                     15595000
procedure resetDB(where);                                               15600000
value             where ;                                               15605000
integer           where ;                                               15610000
option external, privileged, uncallable;                                15615000
                                                                        15620000
COMMENT                                                                 15625000
                                                                        15630000
The procedure resetDB  is  called  after  calling  setsysDB  to         15635000
restore  DB  to  the  value  that  was  expected  upon  calling         15640000
setsysDB.                                                               15645000
                                                                        15650000
The value returned  by  setsysDB  should  be  supplied  as  the         15655000
parameter  for  resetDB.    If  'where'  =  -1  then DB will be         15660000
returned to the stack or data segment it was  at  before  being         15665000
set   to  an  absolute  location.    If  'where'  =  0  then  a         15670000
suddendeath(611) will result.  If 'where' is any value beside 0         15675000
or -1 then DB will be set to  the  absolute  location  'where'.         15680000
;                                                                       15685000
                                                                        15690000
$PAGE "EXTERNAL PROCEDURE: SUDDENDEATH"                                 15695000
procedure suddendeath(N);                                               15700000
value                 N ;                                               15705000
integer               N ;                                               15710000
option external, privileged, uncallable;                                15715000
                                                                        15720000
COMMENT                                                                 15725000
                                                                        15730000
Outputs the system halt message with the decimal number N.              15735000
;                                                                       15740000
                                                                        15745000
  <<procedures to be put in other modules>>                             15750000
$PAGE "DB MANIPULATION PROCEDURES : CHANGEDB"                           15755000
double procedure changedb(newdb);                                       15760000
value                     newdb ;                                       15765000
double                    newdb ;                                       15770000
option external, privileged, uncallable;                                15775000
                                                                        15780000
COMMENT --George R. O'Connor. HP Boise Division (11/20/81).             15785000
                                                                        15790000
Purpose:  Performs  an extended EXCHANGEDB  to handle DB being          15795000
set to an absolute address, in bank zero.                               15800000
                                                                        15805000
Error   reporting:   No  error  reporting  occurs  explicitly.          15810000
SUDDENDEATH's  may result from some  of the KERNELC procedures          15815000
which are called.                                                       15820000
                                                                        15825000
External references:                                                    15830000
                     exchangedb                                         15835000
                    ,fixed low memory                                   15840000
                    ,pcb                                                15845000
                    ,resetdb                                            15850000
                    ,setsysdb                                           15855000
                                                                        15860000
Input:                                                                  15865000
     newdb  := A double word value which indicates where DB is          15870000
to  be set to.  If newdb < 0d  then DB will be set to the data          15875000
segment number -newdb.  If newdb = 0d then DB will be returned          15880000
to  the process's stack location.  If  newdb = 1d then DB will          15885000
be  returned  to the data segment or  stack location it was at          15890000
before  being set to an absolute location.  If newdb > 1d then          15895000
DB  will  be set to the absolute  address of newdb.  Note that          15900000
this  permits  DB  to be set to  absolute locations outside of          15905000
bank zero.                                                              15910000
                                                                        15915000
Output:                                                                 15920000
    changedb  :=  The  value which the  caller should save and          15925000
pass  back to changedb so that the previous environment may be          15930000
properly  restored.   If  DB  was  at  the  stack  then  0d is          15935000
returned.   If  DB was set to the  base of a data segment then          15940000
the negative data segment number is returned.  If DB was at an          15945000
absolute  location  then  the  absolute  address  location  is          15950000
returned.                                                               15955000
                                                                        15960000
Side effects:                                                           15965000
     The  dbxdsinfo word of the  current process control block          15970000
may be changed.                                                         15975000
                                                                        15980000
Special considerations:                                                 15985000
     Highly privileged.                                                 15990000
;                                                                       15995000
                                                                        16000000
$IF X7 = ON                                                             16005000
$PAGE "PROCEDURE:  B08'INIT'LOG'DST"                                    16010000
logical procedure b08'init'log'dst(cb'info, size);                      16015000
                                                                        16020000
  value                            cb'info, size ;                      16025000
                                                                        16030000
  integer pointer                  cb'info       ;                      16035000
                                                                        16040000
  integer                                   size ;                      16045000
                                                                        16050000
  option privileged, uncallable                  ;                      16055000
                                                                        16060000
                                                                        16065000
                                                                        16070000
COMMENT                                                                 16075000
                                                                        16080000
  PURPOSE:                                                              16085000
                                                                        16090000
    This procedure will attempt to allocate a new XDS for log-          16095000
    ging purposes.  If successfull, it will initialize the              16100000
    head entry of the new XDS, then link the new XDS into the           16105000
    chain of logging dst's.                                             16110000
                                                                        16115000
                                                                        16120000
  INPUT PARAMETERS:                                                     16125000
                                                                        16130000
    CB'INFO, a pointer to the control block information area            16135000
      of the CIPER data segment for this ldev and level 7.              16140000
                                                                        16145000
    SIZE, which is the number of words required in the new              16150000
      logging XDS.                                                      16155000
                                                                        16160000
                                                                        16165000
  OUTPUT PARAMETERS:                                                    16170000
                                                                        16175000
    B08'INIT'LOG'DST, which is true if successful, false other-         16180000
      wise.                                                             16185000
                                                                        16190000
                                                                        16195000
  SIDE-EFFECTS:                                                         16200000
                                                                        16205000
    If allocation of the new dst is successful, the new dst             16210000
    will be linked in and be ready for use.  If not successful,         16215000
    all logging will be disabled (by setting bit 0 of event'map).       16220000
    cb'info(logging'dst) will not be updated, to retain the             16225000
    link to previous logging dst's (if any).                            16230000
                                                                        16235000
                                                                        16240000
  SPECIAL CONSIDERATIONS:                                               16245000
                                                                        16250000
    When called, DB must be set to the base of the CIPER data           16255000
    segment.                                                            16260000
                                                                        16265000
                                                                        16270000
  CHANGE HISTORY:                                                       16275000
                                                                        16280000
    As issued.                                                          16285000
                                                                        16290000
                                                                        16295000
;                                                                       16300000
$PAGE "PROCEDURE:  B08'INIT'LOG'DST -- LOCAL DECLARATIONS"              16305000
begin                                                                   16310000
                                                                        16315000
  integer pointer                                                       16320000
                                                                        16325000
    log'buffer                                                          16330000
      << points to buffer area in CIPER data segment where  >>          16335000
      << log records may be assembled.                      >>          16340000
                                                                        16345000
  ;                                                                     16350000
                                                                        16355000
                                                                        16360000
  integer                                                               16365000
                                                                        16370000
    old'dst                                                             16375000
      << contains dst index of current log dst >>                       16380000
                                                                        16385000
   ,new'dst                                                             16390000
      << contains dst index of new log dst >>                           16395000
                                                                        16400000
  ;                                                                     16405000
                                                                        16410000
                                                                        16415000
procedure lockseg'(segident, blocked'lock);                             16420000
  value            segident, blocked'lock ;                             16425000
  integer          segident               ;                             16430000
  logical                    blocked'lock ;                             16435000
  option external, privileged, uncallable;                              16440000
                                                                        16445000
procedure unlockseg'(segident);                                         16450000
  value              segident ;                                         16455000
  integer            segident ;                                         16460000
  option external, privileged, uncallable;                              16465000
                                                                        16470000
  declare'move'from'data'segment;                                       16475000
                                                                        16480000
  declare'move'to'data'segment;                                         16485000
                                                                        16490000
                                                               <<07425>>16495000
  declare'get'log'buffer;                                      <<07425>>16500000
                                                               <<07425>>16505000
  declare'put'head'entry;                                      <<07425>>16510000
$PAGE "PROCEDURE:  B08'INIT'LOG'DST -- PROCEDURE BODY"                  16515000
  << First, try to get a new data segment, initialized to >>            16520000
  << all zeros.                                           >>            16525000
                                                                        16530000
  new'dst := getdatasegc(size,size);                                    16535000
  if <> then                                                            16540000
    begin                                                               16545000
      cb'info(event'map) := integer                                     16550000
         ( logical( cb'info(event'map) ) lor %100000 );                 16555000
      b08'init'log'dst := false;                                        16560000
      return;                                                           16565000
    end;                                                                16570000
                                                                        16575000
                                                                        16580000
  << Lock down the new dst so it won't get swapped out of >>            16585000
  << core (for logging speed).                            >>            16590000
                                                                        16595000
  lockseg'(new'dst,false);  << lock but don't freeze >>                 16600000
                                                                        16605000
                                                                        16610000
  << We got a dst, so set up the pointer to the logging  >>             16615000
  << buffer.                                             >>             16620000
                                                                        16625000
  @log'buffer := get'log'buffer(log'buffer);                            16630000
                                                                        16635000
                                                                        16640000
                                                                        16645000
  << Now set up the info for the head entry of the new dst >>           16650000
                                                                        16655000
  cb'info(logging'dst) := new'dst;                                      16660000
  log'buffer(he'length) := head'entry'length;                           16665000
  log'buffer(he'type) := head'entry'type;                               16670000
  log'buffer(he'ldev) := cb'info(logical'device);                       16675000
  log'buffer(he'next'word) := head'entry'length;                        16680000
  log'buffer(he'last'word) := size - 1;                                 16685000
  log'buffer(he'wrap) := integer(false);                       <<07425>>16690000
                                                                        16695000
                                                                        16700000
  << Save the new head entry in the new data segment >>                 16705000
                                                                        16710000
  put'head'entry(log'buffer);                                           16715000
                                                                        16720000
                                                                        16725000
                                                                        16730000
                                                                        16735000
  << Set completion true and return >>                                  16740000
                                                                        16745000
  b08'init'log'dst := true;                                             16750000
                                                                        16755000
                                                                        16760000
  << All done >>                                                        16765000
                                                                        16770000
end;  << of procedure b08'init'log'dst >>                               16775000
                                                                        16780000
$PAGE "PROCEDURE:  B08'ENABLE'LOGGING"                                  16785000
double  procedure b08'enable'logging(cb'info, event);          <<07425>>16790000
                                                                        16795000
  value                              cb'info, event ;                   16800000
                                                                        16805000
  logical pointer                    cb'info        ;                   16810000
                                                                        16815000
  integer                                     event ;                   16820000
                                                                        16825000
  option privileged, uncallable;                                        16830000
                                                                        16835000
                                                                        16840000
COMMENT                                                                 16845000
                                                                        16850000
  PURPOSE:                                                              16855000
                                                                        16860000
    This procedure is called to enable logging of up to sixteen         16865000
    types of events.  The procedure is called with a event type         16870000
    number, which logging is to be enabled for.  In addition,           16875000
    if no logging XDS exists, one will be allocated and init-           16880000
    ialized.  The data segment number of the logging XDS is             16885000
    saved in cb'info(logging'dst).                                      16890000
                                                                        16895000
                                                                        16900000
  INPUT PARAMETERS:                                                     16905000
                                                                        16910000
    CB'INFO, which is a pointer to the control block informa-           16915000
      tion area of the logical driver.  This area contains              16920000
      the dst number of the logging dst, as well as a bit map           16925000
      describing which events to log.                                   16930000
                                                                        16935000
    EVENT, which is an integer in the range of 0 through                16940000
      max'event'number and specifies which event(s) to enable.          16945000
      If zero is passed, all events will be enabled.                    16950000
                                                                        16955000
                                                                        16960000
  OUTPUT PARAMETERS:                                                    16965000
                                                                        16970000
    B08'ENABLE'LOGGING, which is the completion status of the           16975000
      procedure call.  If logging was successfully enabled, a           16980000
      value of one is returned.  If logging could not be enabled,       16985000
      (due to unavailability of an XDS) a value other than one          16990000
      will be returned.                                                 16995000
                                                                        17000000
                                                                        17005000
  SIDE-EFFECTS:                                                         17010000
                                                                        17015000
    One or more XDS's may be allocated in a linked fashion.             17020000
    Certain words of cb'info will updated.                              17025000
                                                                        17030000
                                                                        17035000
  SPECIAL CONSIDERATIONS:                                               17040000
                                                                        17045000
    None.                                                               17050000
                                                                        17055000
                                                                        17060000
  CHANGE HISTORY:                                                       17065000
                                                                        17070000
    8/31/83  Chuck Mayne                                       <<07425>>17075000
                                                               <<07425>>17080000
    Added code to return the logging dst number to the calling <<07425>>17085000
    program.                                                   <<07425>>17090000
                                                                        17095000
;                                                                       17100000
$PAGE "PROCEDURE:  B08'ENABLE'LOGGING -- LOCAL DECLARATIONS"            17105000
begin                                                                   17110000
                                                                        17115000
  << Declaration of local variables >>                                  17120000
                                                                        17125000
  logical                                                               17130000
                                                                        17135000
    bit'mask                                                            17140000
      << Used to generate mask of which event(s) to enable >>           17145000
                                                                        17150000
  ;                                                                     17155000
                                                               <<07425>>17160000
                                                               <<07425>>17165000
  integer                                                      <<07425>>17170000
                                                               <<07425>>17175000
    return'status              = b08'enable'logging            <<07425>>17180000
                                                               <<07425>>17185000
   ,dst'number                 = b08'enable'logging + 1        <<07425>>17190000
                                                               <<07425>>17195000
  ;                                                            <<07425>>17200000
                                                               <<07425>>17205000
$PAGE "PROCEDURE:  B08'ENABLE'LOGGING -- PROCEDURE BODY"                17210000
  << First, see if there is a logging data segment.  If not, >>         17215000
  << try to obtain one from the system.                      >>         17220000
                                                                        17225000
  if cb'info(logging'dst) = nul'dseg then                               17230000
    begin                                                               17235000
      << No logging dst, try to allocate one. >>                        17240000
                                                                        17245000
      if b08'init'log'dst(cb'info,log'dst'size) then                    17250000
        begin                                                           17255000
          cb'info(event'map) := cb'info(event'map) land %77777;         17260000
        end                                                             17265000
      else                                                              17270000
        begin                                                           17275000
          cb'info(event'map) := cb'info(event'map) lor %100000;         17280000
        end;                                                            17285000
    end;                                                                17290000
                                                                        17295000
  << Now we have (or already had) a logging data segment. >>            17300000
  << Convert the event parameter into a bit map, then "or" >>           17305000
  << that map into the event'map of cb'info.               >>           17310000
                                                                        17315000
  if event < 0 then event := -event;                                    17320000
  if event = 0 then                                                     17325000
    begin                                                               17330000
      bit'mask := %77777;                                               17335000
    end                                                                 17340000
  else                                                                  17345000
    begin                                                               17350000
      bit'mask := %40000 & csr(event - 1);                     <<04434>>17355000
    end;                                                                17360000
                                                                        17365000
  cb'info(event'map) := cb'info(event'map) lor bit'mask;                17370000
                                                               <<07425>>17375000
                                                               <<07425>>17380000
  return'status := successful;                                 <<07425>>17385000
  dst'number := cb'info(logging'dst);                          <<07425>>17390000
                                                               <<07425>>17395000
                                                                        17400000
  << All done!! >>                                                      17405000
                                                                        17410000
end;                                                                    17415000
                                                                        17420000
                                                                        17425000
$PAGE "PROCEDURE:  B08'DISABLE'LOGGING"                                 17430000
                                                                        17435000
double  procedure b08'disable'logging(cb'info, event);         <<07425>>17440000
                                                                        17445000
  value                               cb'info, event ;                  17450000
                                                                        17455000
  logical pointer                     cb'info        ;                  17460000
                                                                        17465000
  integer                                      event ;                  17470000
                                                                        17475000
  option privileged, uncallable;                                        17480000
                                                                        17485000
                                                                        17490000
COMMENT                                                                 17495000
                                                                        17500000
  PURPOSE:                                                              17505000
                                                                        17510000
    This procedure will disable one (or all) events from being          17515000
    logged.  It will not release the logging XDS, if any are            17520000
    allocated.                                                          17525000
                                                                        17530000
                                                                        17535000
  INPUT PARAMETERS:                                                     17540000
                                                                        17545000
    CB'INFO, which is a pointer to the control block informa-           17550000
      tion area of the logical driver.  This area contains the          17555000
      event'map, which describes which events are to be logged.         17560000
                                                                        17565000
    EVENT, which is an integer describing the event for which           17570000
      logging is to be disabled.  If zero, all events will be           17575000
      disabled.  Negative values are treated the same as posi-          17580000
      tive, i.e. 5 or -5 will cause event 5 to be disabled.             17585000
                                                                        17590000
                                                                        17595000
  OUTPUT PARAMETERS:                                                    17600000
                                                                        17605000
    None.                                                               17610000
                                                                        17615000
                                                                        17620000
  SIDE-EFFECTS:                                                         17625000
                                                                        17630000
    Event'map of cb'info will be modified appropriately.                17635000
                                                                        17640000
                                                                        17645000
  SPECIAL CONSIDERATIONS:                                               17650000
                                                                        17655000
    When called, DB must be set to the base of the CIPER data           17660000
    segment.                                                            17665000
                                                                        17670000
                                                                        17675000
  CHANGE HISTORY:                                                       17680000
                                                                        17685000
    8/31/83  Chuck Mayne                                       <<07425>>17690000
                                                               <<07425>>17695000
    Added code to return the logging dst number to the calling <<07425>>17700000
    program.                                                   <<07425>>17705000
                                                               <<07425>>17710000
    If all events become disabled, the head entry of the log-  <<07425>>17715000
    ging dst will be updated.                                  <<07425>>17720000
                                                                        17725000
                                                                        17730000
;                                                                       17735000
$PAGE "PROCEDURE:  B08'DISABLE'LOGGING -- LOCAL DECLARATIONS"           17740000
begin                                                                   17745000
                                                                        17750000
  logical                                                               17755000
                                                                        17760000
    bit'mask                                                            17765000
      << Mask generated to turn appropriate logging bits off >>         17770000
                                                                        17775000
  ;                                                                     17780000
                                                               <<07425>>17785000
  integer pointer                                              <<07425>>17790000
                                                               <<07425>>17795000
    log'buffer                                                 <<07425>>17800000
      << Points to logging buffer >>                           <<07425>>17805000
                                                               <<07425>>17810000
  ;                                                            <<07425>>17815000
                                                               <<07425>>17820000
                                                               <<07425>>17825000
  integer                                                      <<07425>>17830000
                                                               <<07425>>17835000
    return'status              = b08'disable'logging           <<07425>>17840000
                                                               <<07425>>17845000
   ,dst'number                 = b08'disable'logging + 1       <<07425>>17850000
                                                               <<07425>>17855000
  ;                                                            <<07425>>17860000
                                                               <<07425>>17865000
                                                               <<07425>>17870000
  declare'move'to'data'segment;                                <<07425>>17875000
                                                               <<07425>>17880000
  declare'put'head'entry;                                      <<07425>>17885000
                                                               <<07425>>17890000
                                                                        17895000
$PAGE "PROCEDURE:  B08'DISABLE'LOGGING -- PROCEDURE BODY"               17900000
  << If the event number is negative, make it positive. >>              17905000
                                                                        17910000
  if event < 0 then event := -event;                                    17915000
                                                                        17920000
                                                                        17925000
  << Now determine if all events or just one are to be dis- >>          17930000
  << abled, and generate the appropriate bit'mask.          >>          17935000
                                                                        17940000
  if event = 0 then                                                     17945000
    begin                                                               17950000
      bit'mask := %100000;                                              17955000
    end                                                                 17960000
  else                                                                  17965000
    begin                                                               17970000
      bit'mask := %137777 & csr(event - 1);                    <<04434>>17975000
    end;                                                                17980000
                                                                        17985000
                                                                        17990000
  << Now "and" the zero'ed bits into the enable'map of  >>              17995000
  << cb'info.                                           >>              18000000
                                                                        18005000
  cb'info(event'map) := cb'info(event'map) land bit'mask;               18010000
                                                               <<07425>>18015000
                                                               <<07425>>18020000
  << If the resultant enable'map will inhibit any logging, >>  <<07425>>18025000
  << update the head entry of the logging dst.             >>  <<07425>>18030000
                                                               <<07425>>18035000
  if cb'info(event'map) <= 0 then put'head'entry(log'buffer);  <<07425>>18040000
                                                               <<07425>>18045000
  return'status := successful;                                 <<07425>>18050000
  dst'number := cb'info(logging'dst);                          <<07425>>18055000
                                                               <<07425>>18060000
                                                                        18065000
                                                                        18070000
  << All done!! >>                                                      18075000
                                                                        18080000
end;  << of procedure b08'disable'logging >>                            18085000
$IF                                                                     18090000
                                                                        18095000
  <<ciper forward procedure declarations>>                              18100000
$PAGE "FORWARD PROCEDURES"                                              18105000
                                                                        18110000
integer procedure b08'device'clear(cb'info, dev'clear'parm);            18115000
                                                                        18120000
  value                            cb'info, dev'clear'parm ;            18125000
                                                                        18130000
  integer pointer                  cb'info                 ;            18135000
                                                                        18140000
  integer                                   dev'clear'parm ;            18145000
                                                                        18150000
  option forward;                                                       18155000
                                                                        18160000
                                                                        18165000
                                                                        18170000
  <<ASCII translation routine>>                                         18175000
$PAGE "PROCEDURE:  B08'ASCII"                                           18180000
integer procedure b08'ascii(word, base, string);                        18185000
                                                                        18190000
  value                     word, base, string ;                        18195000
                                                                        18200000
  integer                   word, base         ;                        18205000
                                                                        18210000
  byte pointer                          string ;                        18215000
                                                                        18220000
  option privileged, uncallable                ;                        18225000
                                                                        18230000
                                                                        18235000
COMMENT                                                                 18240000
                                                                        18245000
  PURPOSE:                                                              18250000
                                                                        18255000
    This procedure performs a binary to ASCII conversion.  It           18260000
    operation is similar to the intrinsic 'ascii.'  The only            18265000
    reason for not using the intrinsic is the fact that the             18270000
    intrinsic cannot be called split-stack.                             18275000
                                                                        18280000
                                                                        18285000
  INPUT PARAMETERS:                                                     18290000
                                                                        18295000
    WORD, which is the 16 bit binary value to be converted.             18300000
                                                                        18305000
    BASE, which indicates the conversion base.  Valid inputs            18310000
      are:                                                              18315000
            8, which specifies convert to octal,                        18320000
           10, which specifies decimal conversion, left jus-            18325000
               tified, or                                               18330000
          -10, which specifies decimal conversion, right jus-           18335000
               tified.                                                  18340000
                                                                        18345000
    STRING, which is a byte pointer to the area where the               18350000
      converted string is to be built.  It must be large enough         18355000
      to contain the largest number to be converted.                    18360000
                                                                        18365000
                                                                        18370000
  OUTPUT PARAMETERS:                                                    18375000
                                                                        18380000
    B08'ASCII, which returns the character count of the                 18385000
      string returned.                                                  18390000
                                                                        18395000
                                                                        18400000
  SIDE-EFFECTS:                                                         18405000
                                                                        18410000
    None.                                                               18415000
                                                                        18420000
                                                                        18425000
  SPECIAL CONSIDERATIONS:                                               18430000
                                                                        18435000
    None.                                                               18440000
                                                                        18445000
                                                                        18450000
  CHANGE HISTORY:                                                       18455000
                                                                        18460000
    As issued.                                                          18465000
                                                                        18470000
;                                                                       18475000
                                                                        18480000
$PAGE "PROCEDURE:  B08'ASCII -- LOCAL DECLARATIONS"                     18485000
                                                                        18490000
begin                                                                   18495000
                                                                        18500000
  integer                                                               18505000
    count                                                               18510000
   ,x                             = x                                   18515000
  ;                                                                     18520000
                                                                        18525000
  logical                                                               18530000
    negative'flag                 := false                              18535000
  ;                                                                     18540000
                                                                        18545000
                                                                        18550000
$PAGE "PROCEDURE:  B08'ASCII -- PROCEDURE BODY"                         18555000
  if base = 8 then                                                      18560000
    begin                                                               18565000
      x := 5;                                                           18570000
      do                                                                18575000
        begin                                                           18580000
          string(x) := word.(13:3) + %60;                               18585000
          word := word & lsr(3);                                        18590000
          x := x - 1                                                    18595000
        end                                                             18600000
      until x < 0;                                                      18605000
                                                                        18610000
      count := 6;                                                       18615000
    end                                                                 18620000
  else                                                                  18625000
    begin                                                               18630000
      << check for positive or negative >>                              18635000
      if word < 0 then                                                  18640000
        begin                                                           18645000
          negative'flag := true;                                        18650000
          word := -word;                                                18655000
        end;                                                            18660000
      x := 5;                                                           18665000
      do                                                                18670000
        begin                                                           18675000
          << parse out digits until word = 0 >>                         18680000
                                                                        18685000
          string(x) := (word mod 10) + %60;                             18690000
          word := word / 10;                                            18695000
          x := x - 1;                                                   18700000
        end                                                             18705000
      until word = 0;                                                   18710000
                                                                        18715000
      if negative'flag then                                             18720000
        begin                                                           18725000
          string(x) := "-";                                             18730000
          x := x - 1;                                                   18735000
        end;                                                            18740000
                                                                        18745000
                                                                        18750000
      count := 5 - x;                                                   18755000
                                                                        18760000
      if count < 6 then                                                 18765000
        if base < 0 then                                                18770000
          begin                                                         18775000
            << number is to be right justified, so fill with >>         18780000
            << leading blanks.                               >>         18785000
                                                                        18790000
            string := " ";                                              18795000
            if 6 - count > 1 then                                       18800000
              begin                                                     18805000
                << Blank out any additional bytes with move >>          18810000
                << statement, now that first byte is blank. >>          18815000
                                                                        18820000
                move string(1) := string,(5-count);                     18825000
              end;                                                      18830000
          end                                                           18835000
        else                                                            18840000
          begin                                                         18845000
            << must move up to left justify >>                          18850000
                                                                        18855000
            move string := string(x+1),(count);                         18860000
          end;                                                          18865000
    end;                                                                18870000
                                                                        18875000
  b08'ascii := count;                                                   18880000
                                                                        18885000
                                                                        18890000
end;  << procedure b08'ascii >>                                         18895000
                                                                        18900000
$PAGE "CIPER GEN MESSAGE"                                               18905000
INTEGER PROCEDURE Cpr'genmsg(setno, msgno, mask, parm1, parm2,          18910000
                              parm3, parm4, parm5, dest, reply,         18915000
                               offset, dst, control             );      18920000
                                                                        18925000
value                        setno, msgno, mask, parm1, parm2,          18930000
                              parm3, parm4, parm5, dest, reply,         18935000
                               offset, dst, control              ;      18940000
                                                                        18945000
integer                      setno, msgno,                              18950000
                                                   dest,                18955000
                                       dst                       ;      18960000
                                                                        18965000
logical                                    mask, parm1, parm2,          18970000
                               parm3, parm4, parm5,      reply,         18975000
                                offset,      control             ;      18980000
                                                                        18985000
option privileged, variable, uncallable                            ;    18990000
                                                                        18995000
begin                                                                   19000000
                                                                        19005000
logical array                                                           19010000
       qm18(*)        =q-18                                             19015000
;                                                                       19020000
                                                                        19025000
                                                                        19030000
double dseg    ;                                                        19035000
                                                                        19040000
                                                                        19045000
                                                                        19050000
INTEGER PROCEDURE    iomessage(setno, msgno, mask, parm1, parm2,        19055000
                                parm3, parm4, parm5, dest, reply,       19060000
                                 offset, dst, control             );    19065000
                                                                        19070000
value                          setno, msgno, mask, parm1, parm2,        19075000
                                parm3, parm4, parm5, dest, reply,       19080000
                                 offset, dst, control              ;    19085000
                                                                        19090000
integer                        setno, msgno,                            19095000
                                                     dest,              19100000
                                         dst                       ;    19105000
                                                                        19110000
logical                                      mask, parm1, parm2,        19115000
                                 parm3, parm4, parm5,      reply,       19120000
                                  offset,      control             ;    19125000
                                                                        19130000
option external, privileged, variable, uncallable                  ;    19135000
                                                                        19140000
<< change db to sys db so iomessage can run >>                          19145000
                                                                        19150000
dseg := changedb(512D) ; << get on sys stack for message >>             19155000
                                                                        19160000
                                                                        19165000
                                                                        19170000
<< now move the parameter list in for the call to iomessage >>          19175000
                                                                        19180000
x := 0;                                                                 19185000
do                                                                      19190000
 begin                                                                  19195000
  TOS:=qm18(x);                                                         19200000
  x:=x+1;                                                               19205000
 end until x=15;                                                        19210000
                                                                        19215000
<< call iomessage with the parameter list >>                            19220000
                                                                        19225000
assemble (PCAL iomessage);                                              19230000
                                                                        19235000
<< set up the return value >>                                           19240000
                                                                        19245000
cpr'genmsg := TOS;  <<save the return value>>                           19250000
                                                                        19255000
<< get the user data segment back >>                                    19260000
                                                                        19265000
changedb(dseg) ; << get back on calling stack >>                        19270000
                                                                        19275000
<< we're all through for this time >>                                   19280000
                                                                        19285000
end;                                                                    19290000
                                                                        19295000
                                                                        19300000
                                                                        19305000
  <<general Ciper Data Segment (cds) error reporting and                19310000
       debugging routines>>                                             19315000
$PAGE "PROCEDURE:  CPR'SHUTDOWN"                                        19320000
procedure cpr'shutdown( error'number );                                 19325000
                                                                        19330000
  value                 error'number  ;                                 19335000
                                                                        19340000
  integer               error'number  ;                                 19345000
                                                                        19350000
  option privileged, uncallable       ;                                 19355000
                                                                        19360000
                                                                        19365000
COMMENT                                                                 19370000
                                                                        19375000
  PURPOSE:                                                              19380000
                                                                        19385000
    This procedure will mark the ldtx entry for the current             19390000
    ldev such that any other calls to this ldev will be re-             19395000
    jected.  This is done whenever (if ever) an integrity error         19400000
    is detected in the CIPER data segment.  If this is the              19405000
    first call to this procedure, a console message will be             19410000
    issued.                                                             19415000
                                                                        19420000
    Since cpr'shutdown may be called anywhere by CIPER pro-             19425000
    cedures that may not have the ldev number handy, the stack          19430000
    marker chain is followed until the call from ATTACHIO is            19435000
    found.  The ldev number is picked off the stack at that             19440000
    point.                                                              19445000
                                                                        19450000
                                                                        19455000
  INPUTS:                                                               19460000
                                                                        19465000
    ERROR'NUMBER, which is an internal error code indicating            19470000
      the source of the caller and type of error condition.             19475000
      If a console message is generated, this code will be a            19480000
      part of that message.                                             19485000
                                                                        19490000
                                                                        19495000
  OUTPUT PARAMETERS:                                                    19500000
                                                                        19505000
    None.                                                               19510000
                                                                        19515000
                                                                        19520000
  SIDE-EFFECTS:                                                         19525000
                                                                        19530000
    The ldtx'CPR'is'shutdown bit will be set in the ldtx entry          19535000
    for the appropriate CIPER ldev.                                     19540000
                                                                        19545000
    There are two cases where suddendeaths may occur.  One is           19550000
    if we cannot find the ldev numbers at all in the stack,             19555000
    probably because some of the stack markers have been cor-           19560000
    rupted.  The other reason is if we can find both places             19565000
    where the ldev number is, but the two numbers don't match.          19570000
                                                                        19575000
                                                                        19580000
  SPECIAL CONSIDERATIONS:                                               19585000
                                                                        19590000
    This procedure is written with three underlying assump-             19595000
    tions:                                                              19600000
                                                                        19605000
    a)  That all CIPER procedures reside in the same code               19610000
        segment.  This allows the stack walk-back to detect             19615000
        Attachio's stack marker.                                        19620000
                                                                        19625000
    b)  The ldev parameter to Attachio and B08'logical'dvr              19630000
        is always the first of nine parameters.                         19635000
                                                                        19640000
    c)  That the Q+1 to Q+4 area of B08'logical'dvr exactly             19645000
        matches the same area of Cpr'shutdown.  Cpr'shutdown            19650000
        expects to drop Q back to b08'logical'dvr's stack and           19655000
        use the information in the Q+1 to Q+4 area.                     19660000
                                                                        19665000
                                                                        19670000
  CHANGE HISTORY:                                                       19675000
                                                                        19680000
    As issued.                                                          19685000
                                                                        19690000
                                                                        19695000
;                                                                       19700000
$PAGE "PROCEDURE:  CPR'SHUTDOWN -- LOCAL VARIABLES"                     19705000
begin                                                                   19710000
                                                                        19715000
  << NOTE:  The following three variables MUST remain at >>             19720000
  << Q+1 through Q+4, or at least be consistent with the >>             19725000
  << b08'logical'dvr declarations.                       >>             19730000
                                                                        19735000
  << These variables are only used after the Q register  >>             19740000
  << has been set back at the base of b08'logical'dvr's  >>             19745000
  << stack.  This information is used to clean up and    >>             19750000
  << exit out through the tail end of b08'logical'dvr.   >>             19755000
                                                                        19760000
                                                                        19765000
  logical                                                               19770000
                                                                        19775000
    ldvr'exit'label'saved                                               19780000
      << Label on b08'logical'dvr stack that is exit address >>         19785000
                                                                        19790000
  ;                                                                     19795000
                                                                        19800000
                                                                        19805000
  double                                                                19810000
                                                                        19815000
    ldvr'callers'db                                                     19820000
      << Place to store where we were when we go to the >>              19825000
      << callers stack.                                 >>              19830000
  ;                                                                     19835000
                                                                        19840000
                                                                        19845000
  logical pointer                                                       19850000
                                                                        19855000
    ldvr'control'table                                                  19860000
      << pointer on b08'logical'dvr stack that must be set >>           19865000
      << to nil before exiting.                            >>           19870000
                                                                        19875000
  ;                                                                     19880000
                                                                        19885000
                                                                        19890000
  integer                                                               19895000
                                                                        19900000
    return'status                 = q-14                                19905000
      << return status of b08'logical'dvr stack >>                      19910000
                                                                        19915000
  ;                                                                     19920000
                                                                        19925000
$PAGE                                                                   19930000
  logical                                                               19935000
                                                                        19940000
    stack'marker'saved                                                  19945000
      << Saves the address of the Attachio stack marker. >>             19950000
                                                                        19955000
  ;                                                                     19960000
                                                                        19965000
                                                                        19970000
  logical pointer                                                       19975000
                                                                        19980000
    ldt                                                        <<07425>>19985000
      << LOCAL table pointer for zero'th entry of ldt >>       <<07425>>19990000
                                                                        19995000
   ,ldtx                                                                20000000
      << LOCAL table pointer for ldtx entry >>                 <<07425>>20005000
                                                                        20010000
   ;                                                                    20015000
                                                                        20020000
                                                                        20025000
  integer pointer                                                       20030000
                                                                        20035000
    stack'marker                                                        20040000
      << Used for indexing information out of the stack >>              20045000
                                                                        20050000
  ;                                                                     20055000
                                                                        20060000
                                                                        20065000
  integer                                                               20070000
                                                                        20075000
    logical'device                                                      20080000
      << device number of CIPER device to shutdown >>                   20085000
   ,ldtx'index:=0 << For LDT access. Must be zero. >>          <<07425>>20090000
   ,our'cst                                                             20095000
      << Saves the code segment we are in so we may look  >>            20100000
      << for a different segment number in the stack      >>            20105000
      << marker trace                                     >>            20110000
                                                                        20115000
                                                                        20120000
  ;                                                                     20125000
                                                                        20130000
                                                                        20135000
  define                                                                20140000
                                                                        20145000
    s'm'delta'Q                   = 0 #                                 20150000
      << stack marker word containing delta-Q to next >>                20155000
      << marker.                                      >>                20160000
                                                                        20165000
   ,s'm'cst'number                = -1).(8:8 #                          20170000
      << portion of stack marker which contains the cst >>              20175000
      << number of the procedure which made the pcal.   >>              20180000
                                                                        20185000
   ,ldev'parameter                = -12 #                               20190000
      << location of the ldev parameter of ATTACHIO and >>              20195000
      << b08'logical'dvr relative to their pcal stack   >>              20200000
      << markers.                                       >>              20205000
                                                                        20210000
  ;                                                                     20215000
                                                                        20220000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            20225000
equate                                                                  20230000
       table'entry'data    = 0                                          20235000
      ,table'entry'size    = -1 + table'entry'data                      20240000
      ,table'status        = -1 + table'entry'size                      20245000
      ,table'current'entry = -1 + table'status                          20250000
      ,table'base          = -1 + table'current'entry                   20255000
      ,table'dst           = -1 + table'base                            20260000
      ,table'sir           = -1 + table'dst                             20265000
      ,table'overhead      = -table'sir                                 20270000
;                                                                       20275000
define                                                                  20280000
       table'clean         = table'status).(0:1 #                       20285000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               20290000
      ,table'auto'sir      = table'status).(1:1 #                       20295000
      ,table'getsir'save   = table'status).(2:2 #                       20300000
      ,table'type          = table'status).(13:3 #                      20305000
;                                                                       20310000
                                                                        20315000
declare'move'from'data'segment;                                         20320000
                                                                        20325000
declare'move'to'data'segment;                                           20330000
                                                                        20335000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  20340000
subroutine open'table(T, dst, base, type, sir, auto'sir);               20345000
value                    dst, base, type, sir, auto'sir ;               20350000
logical pointer       T                                 ;               20355000
integer                  dst, base, type, sir           ;               20360000
logical                                        auto'sir ;               20365000
begin                                                 <<sxit return>>   20370000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           20375000
                                                                        20380000
COMMENT                                                                 20385000
                                                                        20390000
Purpose:                                                                20395000
                                                                        20400000
Error reporting:                                                        20405000
                                                                        20410000
External references:                                                    20415000
                                                                        20420000
Input:                                                                  20425000
                                                                        20430000
Output:                                                                 20435000
                                                                        20440000
Side effects:                                                           20445000
                                                                        20450000
Special considerations:  Must be called on the user's stack.            20455000
;                                                                       20460000
                                                                        20465000
  <<make some space on the stack directly under the calling             20470000
    parameters for the table'overhead area of table T of size           20475000
    table'overhead.>>                                                   20480000
assemble(lra s-0                                                        20485000
        ;stax                                                           20490000
        ;adds table'overhead <<the amount of space needed>>             20495000
        ;lra s-0  <<destination address>>                               20500000
        ;ldxa  <<source address>>                                       20505000
        ;ldni 7 <<the negative count of the parameter                   20510000
                  list size plus the return address  >>                 20515000
        ;move                                                           20520000
);                                                                      20525000
                                                                        20530000
  <<set the address of the table>>                                      20535000
assemble(lra s-6                                                        20540000
        ;stax                                                           20545000
);                                                                      20550000
@T:=x;                                                                  20555000
                                                                        20560000
  <<initialize the table's control area>>                               20565000
T(table'sir):=sir;                                                      20570000
T(table'dst):=dst;                                                      20575000
T(table'base):=base;                                                    20580000
T(table'current'entry):=0;                                              20585000
                                                                        20590000
  << T(table'status) variable >>                                        20595000
T(table'status) := 0;                                                   20600000
T(table'clean):=true;                                                   20605000
T(table'auto'sir):=auto'sir;                                            20610000
T(table'getsir'save):=0;                                                20615000
T(table'type):=type;                                                    20620000
                                                                        20625000
  << T(table'entry'size) >>                                             20630000
<< Extract the number of words in the entry for the >>         <<07425>>20635000
<< move from the extra data segment to the stack.   >>         <<07425>>20640000
<< If the table type is 0 then the entry size is    >>         <<07425>>20645000
<< already in the overhead area, else extract the   >>         <<07425>>20650000
<< count from word 1 of the zero'th entry.          >>         <<07425>>20655000
IF T(TABLE'TYPE) <> 0                                          <<07425>>20660000
   THEN                                                        <<07425>>20665000
      BEGIN                                                    <<07425>>20670000
      MFDS(T(TABLE'ENTRY'SIZE),  << TARGET WORD >>             <<07425>>20675000
           T(TABLE'DST),         << SOURCE DST # >>            <<07425>>20680000
           T(TABLE'BASE)+1,      << SOURCE OFFSET INTO XDS >>  <<07425>>20685000
           1);                   << COUNT >>                   <<07425>>20690000
      END;                                                     <<07425>>20695000
                                                               <<07425>>20700000
                                                               <<07425>>20705000
                                                               <<07425>>20710000
                                                                        20715000
  <<make some space on the stack directly under the calling             20720000
    parameters for the table'entry'data of size                         20725000
    = table(table'entry'size).>>                                        20730000
x:=T(table'entry'size);                                                 20735000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      20740000
                the return address in x.>>                              20745000
        ;adds 0 <<add the space to the stack.>>                         20750000
        ;ldxa  <<put the return address on the stack.>>                 20755000
);                                                                      20760000
                                                                        20765000
end;  <<open'table>>                                                    20770000
                                                                        20775000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   20780000
subroutine put'entry(T);                                                20785000
value                T ;                                                20790000
logical pointer      T ;                                                20795000
begin                                                                   20800000
                                                                        20805000
COMMENT                                                                 20810000
                                                                        20815000
Special considerations:  Must be called on the user's stack.            20820000
;                                                                       20825000
                                                                        20830000
if T(table'clean) then return;                                          20835000
                                                                        20840000
T(table'clean):=true;                                                   20845000
                                                                        20850000
mtds(T(table'dst),                     <<target'dseg'num>>              20855000
                                                                        20860000
     logical(integer(T(table'base)) +  <<target'offset>>                20865000
     integer(T(table'entry'size)) *                                     20870000
     integer(T(table'current'entry))),                                  20875000
                                                                        20880000
     T,                                <<source>>                       20885000
                                                                        20890000
     T(table'entry'size)               <<word'cnt>> );                  20895000
                                                                        20900000
if T(table'auto'sir) then                                               20905000
  relsir(T(table'sir), T(table'getsir'save));                           20910000
                                                                        20915000
end;  <<put'entry>>                                                     20920000
                                                                        20925000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   20930000
subroutine get'entry(T, index);                                         20935000
value                T, index ;                                         20940000
logical pointer      T        ;                                         20945000
integer                 index ;                                         20950000
begin                                                                   20955000
                                                                        20960000
COMMENT                                                                 20965000
                                                                        20970000
Special considerations:  Must be called on the user's stack.            20975000
;                                                                       20980000
                                                                        20985000
if not T(table'clean) then put'entry(T);                                20990000
                                                                        20995000
if T(table'auto'sir) then                                               21000000
  T(table'getsir'save):=getsir(T(table'sir));                           21005000
                                                                        21010000
mfds(T,                                <<target>>                       21015000
                                                                        21020000
     T(table'dst),                     <<source'dseg'num>>              21025000
                                                                        21030000
     logical(integer(T(table'base)) +  <<source'offset>>                21035000
     integer(T(table'entry'size)) *                                     21040000
     index),                                                            21045000
                                                                        21050000
     T(table'entry'size)               <<word'cnt>>);                   21055000
                                                                        21060000
T(table'current'entry):=index;                                          21065000
T(table'clean):=false;                                                  21070000
                                                                        21075000
end;  <<get'entry>>                                                     21080000
$PAGE "PROCEDURE:  CPR'SHUTDOWN -- PROCEDURE BODY"                      21085000
  << First, get back to the stack from where ever we are. >>            21090000
                                                                        21095000
  changedb( 0D );                                              <<07425>>21100000
                                                                        21105000
                                                                        21110000
  << Initialize the stack pointer to the current value of >>            21115000
  << the Q-register.                                      >>            21120000
                                                                        21125000
  @stack'marker := @delta'q;                                            21130000
                                                                        21135000
                                                                        21140000
  << Initialize the Code Segment numbers used for comparison >>         21145000
                                                                        21150000
  our'cst := stack'marker(s'm'cst'number);                              21155000
                                                                        21160000
                                                                        21165000
  << Now chain back down the stack until a stack marker is >>           21170000
  << found with a different CST number in it.  This will be >>          21175000
  << the ATTACHIO stack marker.                             >>          21180000
                                                                        21185000
  do                                                                    21190000
    begin                                                               21195000
                                                                        21200000
      if stack'marker(s'm'delta'Q) < 0 then suddendeath(635);           21205000
                                                                        21210000
      @stack'marker := @stack'marker                                    21215000
                     - stack'marker(s'm'delta'Q);                       21220000
                                                                        21225000
      if @stack'marker < nil then suddendeath(635);                     21230000
                                                                        21235000
    end                                                                 21240000
  until stack'marker(s'm'cst'number) <> our'cst;                        21245000
                                                                        21250000
  << When we fall through the loop, stack'marker should  >>             21255000
  << be pointing to the stack marker left by the call    >>             21260000
  << from Attachio to B08'logical'dvr.  Our copy of the  >>             21265000
  << ldev number should be twelve words below that stack >>             21270000
  << marker.                                             >>             21275000
                                                                        21280000
  << Pull the ldev number that ATTACHIO gave us. >>                     21285000
                                                                        21290000
  logical'device := stack'marker(ldev'parameter);                       21295000
                                                                        21300000
                                                                        21305000
  << Save the stack marker of Attachio >>                               21310000
                                                                        21315000
  stack'marker'saved := @stack'marker;                                  21320000
                                                                        21325000
                                                                        21330000
  << Drop stack'marker down one more marker, to the one that >>         21335000
  << was left by who ever called Attachio.  The ldev number  >>         21340000
  << that was given to Attachio will be twelve words below.  >>         21345000
  << Compare it to ours as a double check that we are going  >>         21350000
  << to shut down the correct ldev.                          >>         21355000
                                                                        21360000
  @stack'marker := @stack'marker                                        21365000
                 - stack'marker(s'm'delta'Q);                           21370000
                                                                        21375000
  if logical'device <> stack'marker(ldev'parameter) then                21380000
    begin                                                               21385000
                                                                        21390000
      suddendeath(635);                                                 21395000
                                                                        21400000
    end;                                                                21405000
                                                                        21410000
                                                                        21415000
  << We have now verified the logical device, so fix up its >>          21420000
  << ldtx entry for shutdown.                               >>          21425000
                                                                        21430000
  << Open the ldt. >>                                                   21435000
                                                                        21440000
  open'table( ldt,                                             <<07425>>21445000
              ldt'dst,                                                  21450000
              0 << base >>,                                             21455000
              1 << table type >>,                                       21460000
              ldt'sir,                                                  21465000
              false << auto'sir >>  );                                  21470000
                                                                        21475000
  << Get the head entry. >>                                             21480000
                                                                        21485000
  get'entry( ldt,  0 );                                        <<07425>>21490000
                                                                        21495000
                                                                        21500000
  << Open the ldtx. >>                                                  21505000
                                                                        21510000
  open'table( ldtx,                                                     21515000
              ldt'dst,                                         <<07425>>21520000
              ldtx'base,                                                21525000
              1, << table type >>                                       21530000
              ldt'sir,                                         <<07425>>21535000
              true << auto'sir >>  );                                   21540000
                                                                        21545000
                                                                        21550000
  << Get the entry for this ldev >>                                     21555000
                                                                        21560000
  get'entry( ldtx, logical'device );                                    21565000
                                                                        21570000
                                                                        21575000
  << If the device is not already shutdown then issue a >>              21580000
  << console message.                                   >>              21585000
                                                                        21590000
  if not ldtx'ciper'shut'down then                             <<07425>>21595000
    begin                                                               21600000
                                                                        21605000
      cpr'genmsg( ciper'set,                                            21610000
                  shutdown'msg,                                         21615000
                  %10000, << parm mask and types >>                     21620000
                  logical'device,                                       21625000
                  , << parm 2 >>                                        21630000
                  , << parm 3 >>                                        21635000
                  , << parm 4 >>                                        21640000
                  , << parm 5 >>                                        21645000
                  0                 );                                  21650000
                                                                        21655000
    end;                                                                21660000
                                                                        21665000
                                                                        21670000
  << Mark the ldtx entry as a ciper device that is shutdown >>          21675000
                                                                        21680000
  ldtx'ciper'protocol := set'bit;                              <<07425>>21685000
                                                                        21690000
  ldtx'ciper'shut'down := set'bit;                             <<07425>>21695000
                                                                        21700000
                                                                        21705000
  << Put the modified entry back into the ldtx. >>                      21710000
                                                                        21715000
  put'entry( ldtx );                                                    21720000
                                                                        21725000
                                                                        21730000
  << Issue a device close to the transport service, so it  >>  <<04460>>21735000
  << can deallocate if necessary.  MTS, for example, can-  >>  <<04460>>21740000
  << not shut the line if there is a terminal allocated    >>  <<04460>>21745000
  << on the line.  The call is made directly to P'ATTACHIO >>  <<04460>>21750000
  << because the Level 4 control block may be inaccessible >>  <<04460>>21755000
  << as a result of the integrity error that got us here.  >>  <<04460>>21760000
  << Ignor the return status of P'ATTACHIO.                >>  <<04460>>21765000
                                                               <<04460>>21770000
  p'attachio( logical'device                                   <<04460>>21775000
             ,0 << qmisc >>                                    <<04460>>21780000
             ,0 << dst'num >>                                  <<04460>>21785000
             ,0 << address >>                                  <<04460>>21790000
             ,device'close                                     <<04460>>21795000
             ,0 << count >>                                    <<04460>>21800000
             ,0 << parm1 >>                                    <<04460>>21805000
             ,0 << parm2 >>                                    <<04460>>21810000
             ,blocked  << flags >> );                          <<04460>>21815000
                                                               <<04460>>21820000
                                                               <<04460>>21825000
  << We now have the ldev locked out so any further calls  >>           21830000
  << will be rejected.  We still need to get out of this   >>           21835000
  << request, however.  We cannot simply return to the     >>  <<04460>>21840000
  << procedure that called us, because it may not be cap-  >>           21845000
  << able of a graceful exit.  But we do need to exit thru >>           21850000
  << b08'logical'dvr so it can evaluate whether or not an  >>           21855000
  << IOQ should be returned.  To do that, we just move the >>           21860000
  << Q-register back to b08'logical'dvr's local variables, >>           21865000
  << set its control'table pointer to nil (to inhibit any  >>           21870000
  << calls to cpr'rel'ct), set up the appropriate return   >>           21875000
  << status, and jump (via an sxit instruction) to the     >>           21880000
  << exit label conveniently provided by b08'logical'dvr.  >>           21885000
                                                                        21890000
  << Force the stack back to where it was in the outer      >>          21895000
  << procedure of CIPER (b08'logical'dvr) so we can fake up >>          21900000
  << the return status, go back to the callers db, and exit >>          21905000
                                                                        21910000
  TOS := stack'marker'saved;                                            21915000
                                                                        21920000
  set(Q);                                                               21925000
                                                                        21930000
                                                                        21935000
  << Set b08'logical'dvr return status >>                               21940000
                                                                        21945000
  return'status := fatal'error;                                         21950000
                                                                        21955000
                                                                        21960000
  << Force the control'table pointer of b08'logical'dvr to >>           21965000
  << nil, so cpr'rel'ct will not get called as we exit.    >>           21970000
                                                                        21975000
  @ldvr'control'table := nil;                                           21980000
                                                                        21985000
                                                                        21990000
  << Get back to the dst that the original caller came to >>            21995000
  << us on.                                               >>            22000000
                                                                        22005000
  changedb( ldvr'callers'db );                                 <<07425>>22010000
                                                                        22015000
                                                                        22020000
  << Set up the exit label and get the hell out of here!! >>            22025000
                                                                        22030000
  TOS := ldvr'exit'label'saved;                                         22035000
                                                                        22040000
  assemble( sxit 0 );                                                   22045000
                                                                        22050000
end;  << of procedure cpr'shutdown >>                                   22055000
                                                                        22060000
$PAGE "PROCEDURE: CPR'INTERNAL'ERROR"                                   22065000
procedure cpr'internal'error;                                           22070000
                                                                        22075000
  option privileged, uncallable;                                        22080000
                                                                        22085000
begin                                                                   22090000
                                                                        22095000
  cpr'shutdown(1000);                                                   22100000
                                                                        22105000
end; <<cpr'internal'error>>                                             22110000
                                                                        22115000
$PAGE "PROCEDURE: CPR'CODING'ERROR"                                     22120000
procedure cpr'coding'error;                                             22125000
                                                                        22130000
  option privileged, uncallable;                                        22135000
                                                                        22140000
begin                                                                   22145000
                                                                        22150000
  cpr'shutdown(2000);                                                   22155000
                                                                        22160000
end; <<cpr'coding'error>>                                               22165000
                                                                        22170000
$PAGE "PROCEDURE: CPR'LIMIT'ERROR"                                      22175000
procedure cpr'limit'error;                                              22180000
                                                                        22185000
  option privileged, uncallable;                                        22190000
                                                                        22195000
begin                                                                   22200000
                                                                        22205000
  cpr'shutdown(3000);                                                   22210000
                                                                        22215000
end; <<cpr'limit'error>>                                                22220000
                                                                        22225000
$PAGE "PROCEDURE: CPR'ASSERTION"                                        22230000
procedure cpr'assertion(assertion);                                     22235000
                                                                        22240000
  value                 assertion ;                                     22245000
                                                                        22250000
  logical               assertion ;                                     22255000
                                                                        22260000
  option privileged, uncallable, variable;                              22265000
                                                                        22270000
begin                                                                   22275000
                                                                        22280000
  if not parm'mask.(15:1) then                                          22285000
    cpr'shutdown(4000)                                                  22290000
  else                                                                  22295000
    if not assertion then                                               22300000
      cpr'shutdown(5000);                                               22305000
                                                                        22310000
end; <<cpr'assertion>>                                                  22315000
                                                                        22320000
  <<generic Ciper Data Segment (cds) area management routines>>         22325000
    <<routines for cpr'get'cds'area & cpr'get'2ndary'cds'area>>         22330000
$PAGE "PROCEDURE: CPR'INIT'CDS'AREA"                                    22335000
integer procedure cpr'init'cds'area(mem, area'needed,                   22340000
                                    type, init'value);                  22345000
                                                                        22350000
  value                             mem, area'needed,                   22355000
                                    type, init'value ;                  22360000
                                                                        22365000
  logical pointer                   mem                                 22370000
                                                     ;                  22375000
                                                                        22380000
  integer                                area'needed                    22385000
                                                     ;                  22390000
                                                                        22395000
  logical                                                               22400000
                                    type, init'value ;                  22405000
                                                                        22410000
  option privileged, uncallable, variable;                              22415000
                                                                        22420000
begin                                                                   22425000
                                                                        22430000
COMMENT                                                                 22435000
                                                                        22440000
Purpose:  Do all the initialization of a block of memory in the         22445000
CIPER Data Segment.                                                     22450000
                                                                        22455000
Input:                                                                  22460000
     mem := pointer to the memory area to be initialized.               22465000
     area'needed := the size of the memory area to be used for          22470000
data.  Area'needed + cds'area'overhead must = the size of               22475000
new'mem'end.                                                            22480000
     type := the type identification code for the memory area.          22485000
     init'value := (optional) the initial value if any for the          22490000
data area.  If init'value is not sent then no initialization takes      22495000
place.                                                                  22500000
                                                                        22505000
Output:                                                                 22510000
     cpr'init'area := returns the pointer to the data area requested.   22515000
The data area is nestled within its header and trailer.                 22520000
                                                                        22525000
Side effects: The data area is initialized.                             22530000
                                                                        22535000
Special considerations:  This procedure must be called with DB          22540000
pointing to the CDS.                                                    22545000
;                                                                       22550000
                                                                        22555000
define                                                                  22560000
       init'value'     = (15:1) #                                       22565000
;                                                                       22570000
                                                                        22575000
@mem := @mem+cds'area'offset;                                           22580000
                                                                        22585000
mem(cds'area'size) := area'needed + cds'area'overhead;                  22590000
mem(cds'area'type) := type;                                             22595000
                                                                        22600000
mem( mem(cds'area'size) - cds'area'overhead) := mem(cds'area'size);     22605000
                                                                        22610000
if parm'mask.init'value' then                                           22615000
  begin                                                                 22620000
  mem:=init'value;                                                      22625000
  move mem(1) := mem, (area'needed-1);                                  22630000
  end;                                                                  22635000
                                                                        22640000
cpr'init'cds'area:=@mem;                                                22645000
                                                                        22650000
end; <<cpr'init'cds'area>>                                              22655000
                                                                        22660000
    <<end of routines for cpr'get'cds'area &                 >>         22665000
    << cpr'get'2ndary'cds'area                               >>         22670000
$PAGE "PROCEDURE: CPR'GET'CDS'AREA"                                     22675000
integer procedure cpr'get'cds'area(area'needed, type, init'value);      22680000
                                                                        22685000
  value                            area'needed, type, init'value ;      22690000
                                                                        22695000
  integer                          area'needed                   ;      22700000
                                                                        22705000
  logical                                       type, init'value ;      22710000
                                                                        22715000
  option privileged, uncallable, variable;                              22720000
                                                                        22725000
begin                                                                   22730000
                                                                        22735000
COMMENT                                                                 22740000
                                                                        22745000
Purpose: Allocates a portion of memory in a CIPER Data Segment of       22750000
the size and type specified.                                            22755000
                                                                        22760000
Input:                                                                  22765000
     size := the size of the data area required.                        22770000
     type := the type identification code for the data area.            22775000
     init'to'zero (optional) := if present the data area will be        22780000
initialized to zero.                                                    22785000
                                                                        22790000
Output:                                                                 22795000
     cpr'get'cds'area := the data segment base relative pointer to      22800000
the data area.  If no space is available then the pointers value will   22805000
be zero.                                                                22810000
                                                                        22815000
Special Considerations:                                                 22820000
     This procedure must be called with DB pointing at the CDS.         22825000
;                                                                       22830000
                                                                        22835000
define                                                                  22840000
       init'value'     = (15:1) #                                       22845000
;                                                                       22850000
integer                                                                 22855000
        mem'needed                                                      22860000
       ,neg'mem'needed                                                  22865000
       ,remainder                                                       22870000
;                                                                       22875000
integer pointer                                                         22880000
                mem'begin                                               22885000
               ,mem'end                                                 22890000
               ,new'mem'begin                                           22895000
               ,new'mem'end                                             22900000
;                                                                       22905000
logical pointer                                                         22910000
                sha                                                     22915000
;                                                                       22920000
                                                                        22925000
if area'needed = 0 then                                                 22930000
    <<mem'needed = 0 would work for cpr'get'cds'area 's algorithm,      22935000
      but cpr'rel'cds'area would abort when it found the empty heap     22940000
      during its checking.>>                                            22945000
    begin                                                               22950000
    cpr'get'cds'area:=0;                                                22955000
    return;                                                             22960000
    end;                                                                22965000
                                                                        22970000
@sha:=sha'segment'offset;                                               22975000
                                                                        22980000
  <<convert area'needed to a word quantity if needed>>                  22985000
if area'needed < 0 then area'needed := (1-area'needed) to'word;         22990000
                                                                        22995000
mem'needed := area'needed + cds'area'overhead;                          23000000
neg'mem'needed := -mem'needed;                                          23005000
                                                                        23010000
@mem'begin := sha(sha'free'space'tbl'ptr) - 1;                          23015000
                                                                        23020000
try'again:                                                              23025000
while mem'begin <> 0 do                                                 23030000
  begin                                                                 23035000
  if mem'begin <= neg'mem'needed then                                   23040000
      <<we have found an inactive block of a size >= mem'needed>>       23045000
    begin                                                               23050000
      <<compute the ending of the inactive block>>                      23055000
    @mem'end:=@mem'begin(mem'begin+1);                                  23060000
                                                                        23065000
      <<compute the boundaries of the block we are allocating>>         23070000
    @new'mem'end:=@mem'end;                                             23075000
    @new'mem'begin:=@new'mem'end(mem'needed-1);                         23080000
                                                                        23085000
      <<compute beginning of the remainder of the block, if any>>       23090000
    @mem'end:=@new'mem'begin(+1);                                       23095000
      <<adjust the remaining area's block boundarys>>                   23100000
    remainder:=@mem'end - @mem'begin - 1;                               23105000
    if remainder <> 0 then <<adjust remaining space>>                   23110000
      mem'begin := mem'end := remainder;                                23115000
                                                                        23120000
    cpr'get'cds'area :=                                                 23125000
         if parm'mask.init'value' then                                  23130000
             <<initialize the block's contents>>                        23135000
           cpr'init'cds'area(new'mem'end, area'needed, type,            23140000
                init'value)                                             23145000
         else             << v^ - flaky>>                               23150000
           cpr'init'cds'area(new'mem'end, area'needed, type);           23155000
                                                                        23160000
    return;                                                             23165000
    end;                                                                23170000
                                                                        23175000
  @mem'begin:=@mem'begin-\mem'begin\;                                   23180000
                                                                        23185000
end; <<of while>>                                                       23190000
                                                                        23195000
<<currently no space available, later this can try to expand the        23200000
  dst>>                                                                 23205000
                                                                        23210000
cpr'internal'error;                                                     23215000
                                                                        23220000
<<for later: go try'again;>>                                            23225000
                                                                        23230000
end; <<cpr'get'cds'area>>                                               23235000
                                                                        23240000
$PAGE "PROCEDURE: CPR'GET'2NDARY'CDS'AREA"                              23245000
integer procedure cpr'get'2ndary'cds'area(area'needed, type,            23250000
                                                 init'value);           23255000
                                                                        23260000
  value                                   area'needed, type,            23265000
                                                 init'value ;           23270000
                                                                        23275000
  integer                                 area'needed                   23280000
                                                            ;           23285000
                                                                        23290000
  logical                                              type,            23295000
                                                 init'value ;           23300000
                                                                        23305000
  option privileged, uncallable, variable;                              23310000
                                                                        23315000
begin                                                                   23320000
                                                                        23325000
COMMENT                                                                 23330000
                                                                        23335000
Purpose: Allocates a portion of memory in a CIPER Data Segment          23340000
of the size and type specified.  An attempt is made to place            23345000
this memory at a high order address.                                    23350000
                                                                        23355000
Input:                                                                  23360000
     size := the size of the data area required.                        23365000
     type := the type identification code for the data area.            23370000
     init'to'zero (optional) := if present the data area will           23375000
be initialized to zero.                                                 23380000
                                                                        23385000
Output:                                                                 23390000
     cpr'get'2ndary'cds'area := the data segment base relative          23395000
pointer to the data area.  If no space is available then the            23400000
pointers value will be zero.                                            23405000
                                                                        23410000
Special Considerations:                                                 23415000
     This procedure must be called with DB pointing at the CDS.         23420000
;                                                                       23425000
                                                                        23430000
define                                                                  23435000
       init'value'     = (15:1) #                                       23440000
;                                                                       23445000
integer                                                                 23450000
        mem'needed                                                      23455000
       ,neg'mem'needed                                                  23460000
       ,remainder                                                       23465000
;                                                                       23470000
integer pointer                                                         23475000
                mem'begin                                               23480000
               ,mem'end                                                 23485000
               ,new'mem'begin                                           23490000
               ,new'mem'end                                             23495000
;                                                                       23500000
logical pointer                                                         23505000
                sha                                                     23510000
;                                                                       23515000
                                                                        23520000
if area'needed = 0 then                                                 23525000
    <<mem'needed = 0 would work for cpr'get'2ndary'cds'area  >>         23530000
    <<'s algorithm, but cpr'rel'cds'area would abort when it >>         23535000
    <<found the empty heap during its checking.              >>         23540000
   begin                                                                23545000
    cpr'get'2ndary'cds'area:=0;                                         23550000
    return;                                                             23555000
    end;                                                                23560000
                                                                        23565000
@sha:=sha'segment'offset;                                               23570000
                                                                        23575000
  <<convert area'needed to a word quantity if needed         >>         23580000
if area'needed < 0 then area'needed := (1-area'needed) to'word;         23585000
                                                                        23590000
mem'needed := area'needed + cds'area'overhead;                          23595000
neg'mem'needed := -mem'needed;                                          23600000
                                                                        23605000
@mem'begin := sha(sha'free'space'tbl'ptr) - 1;                          23610000
                                                                        23615000
try'again:                                                              23620000
while mem'begin <> 0 do                                                 23625000
  begin                                                                 23630000
  if mem'begin <= neg'mem'needed then                                   23635000
      <<we have found an inactive block of a                 >>         23640000
      << size >= mem'needed                                  >>         23645000
    begin                                                               23650000
      <<compute the ending of the inactive block             >>         23655000
    @mem'end:=@mem'begin(mem'begin+1);                                  23660000
                                                                        23665000
      <<compute the boundaries of the block we are allocating>>         23670000
    @new'mem'begin:=@mem'begin;                                         23675000
    @new'mem'end:=@new'mem'begin(neg'mem'needed+1);                     23680000
                                                                        23685000
      <<compute beginning of the remainder of the block,     >>         23690000
      << if any                                              >>         23695000
    @mem'begin:=@new'mem'end(-1);                                       23700000
      <<adjust the remaining area's block boundarys          >>         23705000
    remainder:=@mem'end - @mem'begin - 1;                               23710000
    if remainder <> 0 then <<adjust remaining space          >>         23715000
      mem'begin := mem'end := remainder;                                23720000
                                                                        23725000
    cpr'get'2ndary'cds'area :=                                          23730000
         if parm'mask.init'value' then                                  23735000
             <<initialize the block's contents               >>         23740000
           cpr'init'cds'area(new'mem'end, area'needed, type,            23745000
                init'value)                                             23750000
         else                                                           23755000
           cpr'init'cds'area(new'mem'end, area'needed, type);           23760000
                                                                        23765000
    return;                                                             23770000
    end;                                                                23775000
                                                                        23780000
  @mem'begin:=@mem'begin-\mem'begin\;                                   23785000
                                                                        23790000
end; <<of while>>                                                       23795000
                                                                        23800000
<<currently no space available, later this can try to expand >>         23805000
<<the dst                                                    >>         23810000
                                                                        23815000
cpr'internal'error;                                                     23820000
                                                                        23825000
<<for later: go try'again;                                   >>         23830000
                                                                        23835000
end; <<cpr'get'2ndary'cds'area>>                                        23840000
                                                                        23845000
$PAGE "PROCEDURE: CPR'REL'CDS'AREA"                                     23850000
procedure cpr'rel'cds'area(cds'area);                                   23855000
                                                                        23860000
  value                    cds'area ;                                   23865000
                                                                        23870000
  logical pointer          cds'area ;                                   23875000
                                                                        23880000
  option privileged, uncallable;                                        23885000
                                                                        23890000
begin                                                                   23895000
                                                                        23900000
COMMENT                                                                 23905000
                                                                        23910000
Purpose: Deallocates the portion of memory in a CIPER Data Segment      23915000
pointed to by cds'area.                                                 23920000
                                                                        23925000
Input:                                                                  23930000
     cds'area := points to the portion of memory to be deallocated.     23935000
                                                                        23940000
Output:                                                                 23945000
                                                                        23950000
Special Considerations:                                                 23955000
     This procedure must be called with DB pointing at the CDS.         23960000
A validity check is made that the area to be released is a valid        23965000
area.  If the memory area is invalid then cpr'initernal'error is        23970000
called.                                                                 23975000
;                                                                       23980000
                                                                        23985000
integer pointer                                                         23990000
                old'mem'begin                                           23995000
               ,old'mem'end                                             24000000
;                                                                       24005000
integer                                                                 24010000
        remainder                                                       24015000
;                                                                       24020000
$PAGE "PROCEDURE: CPR'REL'CDS'AREA;  SUBROUTINE: COLLAPSE'AREAS"        24025000
integer subroutine collapse'areas(fix'up'end, dir, other'end);          24030000
value                             fix'up'end, dir, other'end ;          24035000
integer pointer                   fix'up'end,      other'end ;          24040000
integer                                       dir            ;          24045000
begin                                                                   24050000
                                                                        24055000
if fix'up'end(dir) < 0 then                                             24060000
  begin                                                                 24065000
  remainder:=fix'up'end + fix'up'end( dir );                            24070000
  @fix'up'end:=@fix'up'end( dir * \fix'up'end( dir )\ );                24075000
  fix'up'end:=remainder;                                                24080000
  other'end:=remainder;                                                 24085000
  end;                                                                  24090000
                                                                        24095000
collapse'areas := @fix'up'end;                                          24100000
                                                                        24105000
end; <<collapse'areas>>                                                 24110000
$PAGE "PROCEDURE: CPR'REL'CDS'AREA"                                     24115000
                                                                        24120000
if @cds'area = 0 then return; <<a null (nil) pointer>>                  24125000
                                                                        24130000
@old'mem'end := @cds'area( - cds'area'offset );                         24135000
@old'mem'begin := @old'mem'end( old'mem'end - 1 );                      24140000
                                                                        24145000
  <<verify this is a valid memory block>>                               24150000
if old'mem'begin <= 0 or old'mem'end <= 0 or                            24155000
     old'mem'begin <> old'mem'end then                                  24160000
  cpr'internal'error;                                                   24165000
                                                                        24170000
old'mem'end := -old'mem'end;                                            24175000
old'mem'begin := -old'mem'begin;                                        24180000
                                                                        24185000
@old'mem'begin := collapse'areas(old'mem'begin, 1, old'mem'end);        24190000
@old'mem'end := collapse'areas(old'mem'end, -1, old'mem'begin);         24195000
                                                                        24200000
end; <<cpr'rel'cds'area>>                                               24205000
                                                                        24210000
    <<cpr'lock'cds'area & cpr'unlock'cds'area>>                         24215000
$PAGE "PROCEDURE: CPR'LOCK'CDS'AREA & CPR'UNLOCK'CDS'AREA"              24220000
procedure cpr'lock'cds'area(area'ptr);                                  24225000
                                                                        24230000
  value                     area'ptr ;                                  24235000
                                                                        24240000
  logical pointer           area'ptr ;                                  24245000
                                                                        24250000
  option privileged, uncallable;                                        24255000
                                                                        24260000
begin                                                                   24265000
                                                                        24270000
COMMENT                                                                 24275000
                                                                        24280000
Purpose: to lock or unlock a ciper table in the cds.                    24285000
                                                                        24290000
Input:                                                                  24295000
     area'ptr := pointer to the table.                                  24300000
                                                                        24305000
Side effects:  The table pointed to is locked or unlocked via the sir   24310000
in the table, and the getsir return is saved in the appropriate place   24315000
in the table.                                                           24320000
                                                                        24325000
Special condsiderations:  DB must be pointing to the cds.               24330000
;                                                                       24335000
                                                                        24340000
entry                                                                   24345000
      cpr'unlock'cds'area                                               24350000
;                                                                       24355000
logical                                                                 24360000
        lock                                                            24365000
;                                                                       24370000
integer                                                                 24375000
        table'suptype                                                   24380000
;                                                                       24385000
                                                                        24390000
lock:=true;                                                             24395000
go to key;                                                              24400000
                                                                        24405000
cpr'unlock'cds'area:                                                    24410000
lock:=false;                                                            24415000
                                                                        24420000
key:                                                                    24425000
                                                                        24430000
cpr'assertion( sha'segment'offset <= @area'ptr <=                       24435000
     B08'maximum'dseg'size );                                           24440000
                                                                        24445000
table'suptype := area'ptr(cds'area'suptype);                            24450000
                                                                        24455000
cpr'assertion( sha'type'def <= table'suptype&lsl(8) <=                  24460000
     cbi'suptype'def);                                                  24465000
                                                                        24470000
case table'suptype of                                                   24475000
case'begin                                                              24480000
                                                                        24485000
    <<0 := never should happen>>                                        24490000
  cpr'coding'error;                                                     24495000
                                                                        24500000
    <<1 := sha'type'def>>                                               24505000
  cpr'coding'error;                                                     24510000
                                                                        24515000
    <<2 := ctm'type'def>>                                               24520000
  if lock then  pdisable  else  penable;                                24525000
                                                                        24530000
    <<3 := ct'suptype'def>>                                             24535000
  if lock then  <<do nothing>>  else  <<do nothing>>                    24540000
         <<eventually a sir mechanism will be used>>;                   24545000
                                                                        24550000
    <<4 := cb'suptype'def>>                                             24555000
  cpr'coding'error;                                                     24560000
                                                                        24565000
    <<5 := qh'suptype'def>>                                             24570000
  cpr'coding'error;                                                     24575000
                                                                        24580000
    <<6 := qe'suptype'def>>                                             24585000
  cpr'coding'error;                                                     24590000
                                                                        24595000
    <<7 := qei'suptype'def>>                                            24600000
  cpr'coding'error;                                                     24605000
                                                                        24610000
    <<8 := cbi'suptype'def>>                                            24615000
  cpr'coding'error;                                                     24620000
                                                                        24625000
case'end;                                                               24630000
                                                                        24635000
end; <<cpr'lock'cds'area & cpr'unlock'cds'area>>                        24640000
                                                                        24645000
$PAGE "PROCEDURE: CPR'SIZE'OF'CDS'AREA"                                 24650000
integer procedure cpr'size'of'cds'area(area'ptr);                       24655000
                                                                        24660000
  value                                area'ptr ;                       24665000
                                                                        24670000
  logical pointer                      area'ptr ;                       24675000
                                                                        24680000
  option privileged, uncallable;                                        24685000
                                                                        24690000
begin                                                                   24695000
                                                                        24700000
COMMENT                                                                 24705000
                                                                        24710000
Purpose:  Compute the logical size of a cds area.                       24715000
                                                                        24720000
Input:                                                                  24725000
     area'ptr := pointer to a cds area.                                 24730000
                                                                        24735000
Output:                                                                 24740000
     cpr'cds'area'size := the logical size of area'ptr.                 24745000
;                                                                       24750000
                                                                        24755000
if area'ptr(cds'area'size) <>                                           24760000
     area'ptr(area'ptr(cds'area'size) - 1) then cpr'internal'error;     24765000
                                                                        24770000
cpr'size'of'cds'area := area'ptr(cds'area'size) - cds'area'overhead;    24775000
                                                                        24780000
end; <<cpr'size'of'cds'area>>                                           24785000
                                                                        24790000
  <<Specific Ciper Data Segment (cds) area management routines>>        24795000
    <<routines for cpr'engine>>                                         24800000
      <<routines for cpr'get'ct'of>>                                    24805000
        <<routines for cpr'init'cdda'for>>                              24810000
          <<routines for cpr'get'cdda>>                                 24815000
            <<routines for cpr'init'cds>>                               24820000
$PAGE "PROCEDURE: CPR'INIT'SHA"                                         24825000
procedure cpr'init'sha(initial'dseg'size, maximum'dseg'size);           24830000
                                                                        24835000
  value                initial'dseg'size, maximum'dseg'size ;           24840000
                                                                        24845000
  integer              initial'dseg'size, maximum'dseg'size ;           24850000
                                                                        24855000
  option privileged, uncallable;                                        24860000
                                                                        24865000
begin                                                                   24870000
                                                                        24875000
COMMENT                                                                 24880000
                                                                        24885000
Purpose: Initialize the sha (segment header area) of a cds (ciper       24890000
data segment).                                                          24895000
                                                                        24900000
Input:                                                                  24905000
     initial'dseg'size := the initial data segment size.                24910000
     maximum'dseg'size := the maximum (i.e. largest ever) size of the   24915000
data segment.                                                           24920000
                                                                        24925000
Output: (none)                                                          24930000
                                                                        24935000
Side effects:  DB zero through sha'size area initialized.               24940000
;                                                                       24945000
                                                                        24950000
logical pointer                                                         24955000
                sha                                                     24960000
;                                                                       24965000
                                                                        24970000
@sha:=0; <<DB + 0>>                                                     24975000
                                                                        24980000
@sha:=cpr'init'cds'area(sha, sha'size, sha'type'def, 0);                24985000
                                                                        24990000
  <<adjust the segment size variables>>                                 24995000
if initial'dseg'size > maximum'dseg'size then                           25000000
  maximum'dseg'size := initial'dseg'size;                               25005000
                                                                        25010000
  <<set up the segment size variables>>                                 25015000
sha(sha'max'seg'size) := maximum'dseg'size;                             25020000
sha(sha'seg'size) := initial'dseg'size;                                 25025000
                                                                        25030000
end; <<cpr'init'sha>>                                                   25035000
                                                                        25040000
$PAGE "PROCEDURE: CPR'INIT'CNTL'OF'CDS'AREA"                            25045000
procedure cpr'init'cntl'of'cds'area(sha);                               25050000
                                                                        25055000
  value                             sha ;                               25060000
                                                                        25065000
  logical pointer                   sha ;                               25070000
                                                                        25075000
  option privileged, uncallable;                                        25080000
                                                                        25085000
begin                                                                   25090000
                                                                        25095000
COMMENT                                                                 25100000
                                                                        25105000
Purpose: Initialize the cds for the getting & releasing of cds area,    25110000
as used by cpr'get'cds'area & cpr'rel'cds'area.                         25115000
                                                                        25120000
Input:                                                                  25125000
     sha := pointer to the segment header area which contains the       25130000
sha'free'space'tbl'ptr.                                                 25135000
                                                                        25140000
Output: (none)                                                          25145000
                                                                        25150000
Side effects: The cds is initialized to look like:                      25155000
                                                                        25160000
                      +--------------------------+                      25165000
                      |           sha            |                      25170000
                      z (sha'free'space'tbl'ptr) z ----+                25175000
                      |                          |     |                25180000
                      +--------------------------+     |                25185000
                      |             0            |     |                25190000
                      +--------------------------+     | ---+           25195000
                      |-(initial free area size) |     |    |initial    25200000
                      +--------------------------+     |    |           25205000
                      |                          |     |    |free       25210000
                      z                          z     |    |           25215000
                      z                          z     |    |area       25220000
                      |                          |     |    |           25225000
                      +--------------------------+     |    |size       25230000
                      |-(initial free area size) |     |    |           25235000
                      +--------------------------+     | ---+           25240000
                      |             0            |  <--+                25245000
                      +--------------------------+                      25250000
                                                                        25255000
Special considerations:  DB must be at the cds.                         25260000
;                                                                       25265000
                                                                        25270000
logical pointer                                                         25275000
                mem                                                     25280000
;                                                                       25285000
                                                                        25290000
@mem:=0; <<set to base of dseg>>                                        25295000
                                                                        25300000
mem( sha(cds'area'size) ) := 0;                                         25305000
mem( sha(sha'seg'size) - 1 ) := 0; << = mem( sha(cds'area'size) ) >>    25310000
                                                                        25315000
                                                                        25320000
mem( sha(cds'area'size) + 1 ) :=                                        25325000
     - ( sha(sha'seg'size) - sha(cds'area'size) - 2 );                  25330000
                                                                        25335000
mem( sha(sha'seg'size) - 2 ) := mem( sha(cds'area'size) + 1 );          25340000
                                                                        25345000
                                                                        25350000
sha(sha'free'space'tbl'ptr) := @mem( sha(sha'seg'size) - 1 );           25355000
                                                                        25360000
end; <<cpr'init'cntl'of'cds'area>>                                      25365000
                                                                        25370000
$PAGE "PROCEDURE: CPR'INIT'CTM"                                         25375000
procedure cpr'init'ctm(sha, num'ctm'ents);                              25380000
                                                                        25385000
  value                sha, num'ctm'ents ;                              25390000
                                                                        25395000
  logical pointer      sha               ;                              25400000
                                                                        25405000
  integer                   num'ctm'ents ;                              25410000
                                                                        25415000
  option privileged, uncallable;                                        25420000
                                                                        25425000
begin                                                                   25430000
                                                                        25435000
COMMENT                                                                 25440000
                                                                        25445000
Purpose: Create and initialize the control table map of the cds.        25450000
                                                                        25455000
Input:                                                                  25460000
     sha := pointer to the segment header area of the cds.              25465000
     num'ctm'ents := the number of control table map (ctm) entries      25470000
to configure in.                                                        25475000
                                                                        25480000
Output: (none)                                                          25485000
                                                                        25490000
Side effect: Modifies sha(sha'ctm'ptr) to point to the ctm.             25495000
                                                                        25500000
Special considerations: DB must point to the cds.                       25505000
;                                                                       25510000
                                                                        25515000
integer                                                                 25520000
        area'needed                                                     25525000
       ,entry'size                                                      25530000
;                                                                       25535000
logical pointer                                                         25540000
                ctm                                                     25545000
               ,ctm0                                                    25550000
;                                                                       25555000
                                                                        25560000
entry'size :=                                                           25565000
     if ctm0'size > ctm'ent'size then                                   25570000
       ctm0'size                                                        25575000
     else                                                               25580000
       ctm'ent'size;                                                    25585000
                                                                        25590000
area'needed := entry'size * (num'ctm'ents + 1);                         25595000
                                                                        25600000
@ctm := cpr'get'cds'area(area'needed, ctm'type'def, 0);                 25605000
                                                                        25610000
if @ctm = 0 then cpr'internal'error;                                    25615000
                                                                        25620000
@ctm0:=@ctm(0); <<entry zero>>                                          25625000
                                                                        25630000
sha(sha'ctm'ptr) := @ctm0;                                              25635000
                                                                        25640000
ctm0(ctm0'ent'cnt) := num'ctm'ents;                                     25645000
                                                                        25650000
ctm0(ctm0'ctm'size) := entry'size;                                      25655000
                                                                        25660000
ctm0(ctm0'ent'inuse'cnt) := 0;                                          25665000
                                                                        25670000
end; <<cpr'init'ctm>>                                                   25675000
                                                                        25680000
$PAGE "PROCEDURE: CPR'INIT'LIOQ"                                        25685000
procedure cpr'init'lioq(sha, num'lioq'ents);                            25690000
                                                                        25695000
  value                 sha, num'lioq'ents ;                            25700000
                                                                        25705000
  logical pointer       sha                ;                            25710000
                                                                        25715000
  integer                    num'lioq'ents ;                            25720000
                                                                        25725000
  option privileged, uncallable;                                        25730000
                                                                        25735000
begin                                                                   25740000
                                                                        25745000
logical pointer                                                         25750000
                lioq                                                    25755000
;                                                                       25760000
                                                                        25765000
@lioq := cpr'get'cds'area(0 <<size>>, 0 <<type>>, 0);                   25770000
                                                                        25775000
<< for later>>                                                          25780000
<<if @lioq = 0 then cpr'internal'error;>>                               25785000
                                                                        25790000
sha(sha'lioq'list'ptr) := @lioq;                                        25795000
                                                                        25800000
end; <<cpr'init'lioq>>                                                  25805000
                                                                        25810000
            <<end of routines for cpr'init'cds>>                        25815000
$PAGE "PROCEDURE: CPR'INIT'CDS"                                         25820000
procedure cpr'init'cds(cdda'dseg, initial'dseg'size,                    25825000
                       maximum'dseg'size, num'ctm'ents,                 25830000
                       num'lioq'ents                   );               25835000
                                                                        25840000
  value                cdda'dseg, initial'dseg'size,                    25845000
                       maximum'dseg'size, num'ctm'ents,                 25850000
                       num'lioq'ents                    ;               25855000
                                                                        25860000
  integer              cdda'dseg, initial'dseg'size,                    25865000
                       maximum'dseg'size, num'ctm'ents,                 25870000
                       num'lioq'ents                    ;               25875000
                                                                        25880000
  option privileged, uncallable;                                        25885000
                                                                        25890000
begin                                                                   25895000
                                                                        25900000
COMMENT                                                                 25905000
                                                                        25910000
Purpose:  Initialize the ciper data segment.  DB should be set to       25915000
the data segment to be initialized.                                     25920000
                                                                        25925000
Input:                                                                  25930000
     initial'dseg'size := the initial (i.e. current) size of the        25935000
cds.                                                                    25940000
     maximum'dseg'size := the maximum (i.e. largest possible) size      25945000
of the cds.                                                             25950000
     num'ctm'ents := the number of ctm entries to configure in to       25955000
this cds.                                                               25960000
     num'lioq'ents := the number of lioq (logical IO queue) entries     25965000
to configure in to this cds.                                            25970000
                                                                        25975000
Output: (none)                                                          25980000
                                                                        25985000
Special considerations:  DB must be set to the data segment to be       25990000
initialized.                                                            25995000
;                                                                       26000000
                                                                        26005000
logical pointer                                                         26010000
                sha                                                     26015000
;                                                                       26020000
                                                                        26025000
cpr'init'sha(initial'dseg'size, maximum'dseg'size);                     26030000
                                                                        26035000
@sha:=sha'segment'offset;                                               26040000
                                                                        26045000
sha(sha'cds'dst'num) := cdda'dseg;                                      26050000
                                                                        26055000
cpr'init'cntl'of'cds'area(sha);                                         26060000
                                                                        26065000
cpr'init'ctm(sha, num'ctm'ents);                                        26070000
                                                                        26075000
cpr'init'lioq(sha, num'lioq'ents);                                      26080000
                                                                        26085000
end; <<cpr'init'cds>>                                                   26090000
                                                                        26095000
          <<end of routines for cpr'get'cdda>>                          26100000
$PAGE "PROCEDURE: CPR'GET'CDS"                                          26105000
logical procedure cpr'get'cds(ldev);                                    26110000
                                                                        26115000
  value                       ldev ;                                    26120000
                                                                        26125000
  integer                     ldev ;                                    26130000
                                                                        26135000
  option privileged, uncallable;                                        26140000
                                                                        26145000
begin                                                                   26150000
                                                                        26155000
COMMENT                                                                 26160000
                                                                        26165000
Purpose: Gets a data segment for Ciper.                                 26170000
                                                                        26175000
Input:                                                                  26180000
     ldev := the logical device for which the Ciper Data                26185000
Segment is required.                                                    26190000
                                                                        26195000
Output:                                                                 26200000
     cpr'get'cdda := if a data segment is available.                    26205000
                                                                        26210000
Side effects:                                                           26215000
     DB is left pointing to the cds.                                    26220000
;                                                                       26225000
                                                                        26230000
integer                                                                 26235000
        cds'db                                                          26240000
       ,initial'dseg'size                                               26245000
       ,maximum'dseg'size                                               26250000
       ,num'ctm'ents                                                    26255000
       ,num'lioq'ents                                                   26260000
;                                                                       26265000
                                                                        26270000
initial'dseg'size := B08'initial'dseg'size;                             26275000
maximum'dseg'size := B08'maximum'dseg'size;                             26280000
num'ctm'ents := B08'num'ctm'ents;                                       26285000
num'lioq'ents := B08'num'ctm'ents;                                      26290000
                                                                        26295000
cds'db:=getdatasegc(initial'dseg'size, maximum'dseg'size);              26300000
if <> then                                                              26305000
    <<unable to get a data segment>>                                    26310000
  begin                                                                 26315000
  cpr'get'cds := false;                                                 26320000
  return;                                                               26325000
  end;                                                                  26330000
                                                                        26335000
changedb( double( -cds'db ) );                                 <<07425>>26340000
                                                                        26345000
  <<initialize the cds (sha, free space, ctm, lioq)>>                   26350000
cpr'init'cds(cds'db, initial'dseg'size, maximum'dseg'size,              26355000
     num'ctm'ents, num'lioq'ents);                                      26360000
                                                                        26365000
cpr'get'cds := true;                                                    26370000
                                                                        26375000
end; <<cpr'get'cds>>                                                    26380000
                                                                        26385000
$PAGE "PROCEDURE: CPR'GET'CTMI"                                         26390000
integer procedure cpr'get'ctmi(ctm0, ldev);                             26395000
                                                                        26400000
  value                        ctm0, ldev ;                             26405000
                                                                        26410000
  logical pointer              ctm0       ;                             26415000
                                                                        26420000
  integer                            ldev ;                             26425000
                                                                        26430000
  option privileged, uncallable;                                        26435000
                                                                        26440000
begin                                                                   26445000
                                                                        26450000
COMMENT                                                                 26455000
                                                                        26460000
Purpose: Allocate a control table map entry and return the control      26465000
table map index.                                                        26470000
                                                                        26475000
Error conditions & responses:                                           26480000
                                                                        26485000
Input:                                                                  26490000
     ctm0 := pointer to the ctm of the cds.                             26495000
     ldev := the logical device number to which this entry              26500000
is be assigned.                                                         26505000
                                                                        26510000
Output:                                                                 26515000
      cpr'get'ctmi := the index into the ctm of the entry assigned.     26520000
If zero the no entry was available.                                     26525000
                                                                        26530000
Side effects:  The ctm entry found is updated with the appropriate      26535000
ldev number. <<In the future the sir will go here.>>                    26540000
                                                                        26545000
Special considerations: DB must be set to the cds.                      26550000
;                                                                       26555000
                                                                        26560000
logical pointer                                                         26565000
                ctm                                                     26570000
;                                                                       26575000
                                                                        26580000
cpr'lock'cds'area(ctm0);                                                26585000
                                                                        26590000
if ctm0(ctm0'ent'inuse'cnt) = ctm0(ctm0'ent'cnt) then                   26595000
    <<no entry available>>                                              26600000
  begin                                                                 26605000
  cpr'unlock'cds'area(ctm0);                                            26610000
  cpr'get'ctmi := 0;                                                    26615000
  return;                                                               26620000
  end;                                                                  26625000
                                                                        26630000
  <<point to the first entry>>                                          26635000
@ctm := @ctm0( ctm0(ctm0'ctm'size) );                                   26640000
                                                                        26645000
  <<search for the free entry, there must be one>>                      26650000
while ctm(ctm'ldev) <> 0 do                                             26655000
  @ctm:=@ctm( ctm0(ctm0'ctm'size) );                                    26660000
                                                                        26665000
ctm(ctm'ldev):=ldev; <<secure the entry>>                               26670000
                                                                        26675000
ctm0(ctm0'ent'inuse'cnt) := ctm0(ctm0'ent'inuse'cnt) + 1;               26680000
                                                                        26685000
cpr'unlock'cds'area(ctm0); <<unlock as quickly as possible>>            26690000
                                                                        26695000
  <<the rest of this entry should be clean from either                  26700000
    cpr'init'ctmi or cpr'rel'ctmi >>                                    26705000
                                                                        26710000
  <<compute & return the control table map index>>                      26715000
cpr'get'ctmi := (@ctm - @ctm0) / integer(ctm0(ctm0'ctm'size));          26720000
                                                                        26725000
end; <<cpr'get'ctmi>>                                                   26730000
                                                                        26735000
            <<routines for cpr'init'ct>>                                26740000
$PAGE "PROCEDURE: CPR'INIT'CB"                                          26745000
procedure cpr'init'cb(ct);                                              26750000
                                                                        26755000
  value               ct ;                                              26760000
                                                                        26765000
  logical pointer     ct ;                                              26770000
                                                                        26775000
  option privileged, uncallable;                                        26780000
                                                                        26785000
begin                                                                   26790000
                                                                        26795000
COMMENT                                                                 26800000
                                                                        26805000
Purpose:  Create and initialize the cb for ct(ct'lvl'active).           26810000
                                                                        26815000
Input:                                                                  26820000
     ct := control table pointer.                                       26825000
                                                                        26830000
Output: (none)                                                          26835000
                                                                        26840000
Side effects:  The address of the cb is loaded into ct(ct'lvln'cb'ptr). 26845000
;                                                                       26850000
                                                                        26855000
logical pointer                                                         26860000
                cb                                                      26865000
;                                                                       26870000
                                                                        26875000
@cb := cpr'get'cds'area(cb'size,                                        26880000
     cb'suptype'def lor ct(ct'lvl'active), 0);                          26885000
                                                                        26890000
ct(ct'lvln'cb'ptr + ct(ct'lvl'active)) := @cb;                          26895000
                                                                        26900000
end; <<cpr'init'cb>>                                                    26905000
                                                                        26910000
            <<end of routines for cpr'init'ct>>                         26915000
$PAGE "PROCEDURE: CPR'INIT'CT"                                          26920000
procedure cpr'init'ct(ctmi);                                            26925000
                                                                        26930000
  value               ctmi ;                                            26935000
                                                                        26940000
  integer             ctmi ;                                            26945000
                                                                        26950000
  option privileged, uncallable;                                        26955000
                                                                        26960000
begin                                                                   26965000
                                                                        26970000
integer pointer                                                         26975000
                ct                                                      26980000
;                                                                       26985000
double pointer                                                          26990000
               ct'd            = ct                                     26995000
;                                                                       27000000
logical pointer                                                         27005000
                ctm                                                     27010000
               ,ctm0                                                    27015000
               ,sha                                                     27020000
;                                                                       27025000
                                                                        27030000
@sha := sha'segment'offset;                                             27035000
                                                                        27040000
@ctm0 := sha(sha'ctm'ptr);                                              27045000
                                                                        27050000
@ctm := @ctm0 + integer(ctm0(ctm0'ctm'size)) * ctmi;                    27055000
                                                                        27060000
@ct := cpr'get'cds'area(ct'size'min + b08'ct'lvl'cnt,                   27065000
     ct'suptype'def, 0);                                                27070000
                                                                        27075000
if @ct = 0 then cpr'internal'error;                                     27080000
                                                                        27085000
ctm(ctm'ct'ptr) := @ct;                                                 27090000
                                                                        27095000
ct(ct'cds'dst'num) := sha(sha'cds'dst'num);                             27100000
                                                                        27105000
ct'd(ct'd'callers'db) := nul'db;                                        27110000
                                                                        27115000
ct(ct'ctmi) := ctmi;                                                    27120000
                                                                        27125000
ct(ct'lvl'cnt) := b08'ct'lvl'cnt;                                       27130000
ct(ct'vdt'ptr) := 0;                                                    27135000
                                                                        27140000
ct(ct'lvl'active) := 1;                                                 27145000
while not ( ct(ct'lvl'active) > ct(ct'lvl'cnt) ) do                     27150000
  begin                                                                 27155000
  cpr'init'cb(ct);                                                      27160000
  ct(ct'lvl'active) := ct(ct'lvl'active) + 1;                           27165000
  end;                                                                  27170000
                                                                        27175000
ct(ct'lvl'active) := 0;                                                 27180000
                                                                        27185000
end; <<cpr'init'ct>>                                                    27190000
                                                                        27195000
$PAGE "PROCEDURE: CPR'COND'CHG'LDTX"                                    27200000
procedure cpr'cond'chg'ldtx(ldev, cdda'dseg, ctmi);                     27205000
                                                                        27210000
  value                     ldev, cdda'dseg, ctmi ;                     27215000
                                                                        27220000
  integer                   ldev, cdda'dseg, ctmi ;                     27225000
                                                                        27230000
  option privileged, uncallable;                                        27235000
                                                                        27240000
begin                                                                   27245000
                                                                        27250000
COMMENT                                                                 27255000
                                                                        27260000
Purpose:  Conditionally changes the entry in the ldtx for this          27265000
ldev if the entry hasn't been initialized for CIPER.  If the            27270000
entry hasn't beeninitialized, the CIPER initialization bit is           27275000
set (word0.(2:1)), the CIPER data segment number (word1) is set         27280000
to cdda'dseg, and the CIPER control table map index (word2) is          27285000
set to ctmi.  Otherwise the data segment cdda'dseg is released          27290000
back to the system via the kernal ntrinsic reldataseg.                  27295000
                                                                        27300000
Error reporting:  No error reporting occurs.                            27305000
                                                                        27310000
External references:                                                    27315000
                     reldataseg                                         27320000
                                                                        27325000
Input:                                                                  27330000
     ldev := the logical device for which the ldtx is to be             27335000
conditionally altered.                                                  27340000
     cdda'dseg := the data segment number of a CIPER data segment       27345000
(cds) which has been initialized.                                       27350000
     ctmi := the control table map index for this logical device if     27355000
none has been assigned yet.                                             27360000
                                                                        27365000
Output: None.                                                           27370000
                                                                        27375000
Side effects:  The ldtx entry of this table is changed.                 27380000
                                                                        27385000
Special considerations:  Must be called on the user's stack.            27390000
;                                                                       27395000
                                                                        27400000
logical pointer << The following are LOCAL pointers only >>    <<07425>>27405000
                ldt                                                     27410000
                ,LDT0=LDT                                      <<07425>>27415000
               ,ldtx                                                    27420000
;                                                                       27425000
integer ldtx'index:=0; << Must be zero. >>                     <<07425>>27430000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            27435000
equate                                                                  27440000
       table'entry'data    = 0                                          27445000
      ,table'entry'size    = -1 + table'entry'data                      27450000
      ,table'status        = -1 + table'entry'size                      27455000
      ,table'current'entry = -1 + table'status                          27460000
      ,table'base          = -1 + table'current'entry                   27465000
      ,table'dst           = -1 + table'base                            27470000
      ,table'sir           = -1 + table'dst                             27475000
      ,table'overhead      = -table'sir                                 27480000
;                                                                       27485000
define                                                                  27490000
       table'clean         = table'status).(0:1 #                       27495000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               27500000
      ,table'auto'sir      = table'status).(1:1 #                       27505000
      ,table'getsir'save   = table'status).(2:2 #                       27510000
      ,table'type          = table'status).(13:3 #                      27515000
;                                                                       27520000
                                                                        27525000
$PAGE "UTILITY SUBROUTINE: MFDS"                                        27530000
Subroutine mfds(target, source'dseg'num, source'offset, word'cnt);      27535000
value           target, source'dseg'num, source'offset, word'cnt ;      27540000
logical pointer target                                           ;      27545000
logical                 source'dseg'num, source'offset, word'cnt ;      27550000
begin                                                                   27555000
                                                                        27560000
  assemble(stax; mfds 0; ldxa);                                         27565000
                                                                        27570000
end; <<mfds>>                                                           27575000
                                                                        27580000
                                                                        27585000
$PAGE "UTILITY SUBROUTINE: MTDS"                                        27590000
Subroutine mtds(target'dseg'num, target'offset, source, word'cnt);      27595000
value           target'dseg'num, target'offset, source, word'cnt ;      27600000
logical         target'dseg'num, target'offset,         word'cnt ;      27605000
logical pointer                                 source           ;      27610000
begin                                                                   27615000
                                                                        27620000
  assemble(stax; mtds 0; ldxa);                                         27625000
                                                                        27630000
end; <<mtds>>                                                           27635000
                                                                        27640000
                                                                        27645000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  27650000
subroutine open'table(T, dst, base, type, sir, auto'sir);               27655000
value                    dst, base, type, sir, auto'sir ;               27660000
logical pointer       T                                 ;               27665000
integer                  dst, base, type, sir           ;               27670000
logical                                        auto'sir ;               27675000
begin                                                 <<sxit return>>   27680000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           27685000
                                                                        27690000
COMMENT                                                                 27695000
                                                                        27700000
Purpose:                                                                27705000
                                                                        27710000
Error reporting:                                                        27715000
                                                                        27720000
External references:                                                    27725000
                                                                        27730000
Input:                                                                  27735000
                                                                        27740000
Output:                                                                 27745000
                                                                        27750000
Side effects:                                                           27755000
                                                                        27760000
Special considerations:  Must be called on the user's stack.            27765000
;                                                                       27770000
                                                                        27775000
  <<make some space on the stack directly under the calling             27780000
    parameters for the table'overhead area of table T of size           27785000
    table'overhead.>>                                                   27790000
assemble(lra s-0                                                        27795000
        ;stax                                                           27800000
        ;adds table'overhead <<the amount of space needed>>             27805000
        ;lra s-0  <<destination address>>                               27810000
        ;ldxa  <<source address>>                                       27815000
        ;ldni 7 <<the negative count of the parameter                   27820000
                  list size plus the return address  >>                 27825000
        ;move                                                           27830000
);                                                                      27835000
                                                                        27840000
  <<set the address of the table>>                                      27845000
assemble(lra s-6                                                        27850000
        ;stax                                                           27855000
);                                                                      27860000
@T:=x;                                                                  27865000
                                                                        27870000
  <<initialize the table's control area>>                               27875000
T(table'sir):=sir;                                                      27880000
T(table'dst):=dst;                                                      27885000
T(table'base):=base;                                                    27890000
T(table'current'entry):=0;                                              27895000
                                                                        27900000
  << T(table'status) variable >>                                        27905000
T(table'status) := 0;                                                   27910000
T(table'clean):=true;                                                   27915000
T(table'auto'sir):=auto'sir;                                            27920000
T(table'getsir'save):=0;                                                27925000
T(table'type):=type;                                                    27930000
                                                                        27935000
  << T(table'entry'size) >>                                             27940000
<< Extract the number of words in the entry for the >>         <<07425>>27945000
<< move from the extra data segment to the stack.   >>         <<07425>>27950000
<< If the table type is 0 then the entry size is    >>         <<07425>>27955000
<< already in the overhead area, else extract the   >>         <<07425>>27960000
<< count from word 1 of the zero'th entry.          >>         <<07425>>27965000
IF T(TABLE'TYPE) <> 0                                          <<07425>>27970000
   THEN                                                        <<07425>>27975000
      BEGIN                                                    <<07425>>27980000
      MFDS(T(TABLE'ENTRY'SIZE),  << TARGET WORD >>             <<07425>>27985000
           T(TABLE'DST),         << SOURCE DST # >>            <<07425>>27990000
           T(TABLE'BASE)+1,      << SOURCE OFFSET INTO XDS >>  <<07425>>27995000
           1);                   << COUNT >>                   <<07425>>28000000
      END;                                                     <<07425>>28005000
                                                               <<07425>>28010000
                                                               <<07425>>28015000
                                                               <<07425>>28020000
                                                                        28025000
  <<make some space on the stack directly under the calling             28030000
    parameters for the table'entry'data of size                         28035000
    = table(table'entry'size).>>                                        28040000
x:=T(table'entry'size);                                                 28045000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      28050000
                the return address in x.>>                              28055000
        ;adds 0 <<add the space to the stack.>>                         28060000
        ;ldxa  <<put the return address on the stack.>>                 28065000
);                                                                      28070000
                                                                        28075000
end;  <<open'table>>                                                    28080000
                                                                        28085000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   28090000
subroutine put'entry(T);                                                28095000
value                T ;                                                28100000
logical pointer      T ;                                                28105000
begin                                                                   28110000
                                                                        28115000
COMMENT                                                                 28120000
                                                                        28125000
Special considerations:  Must be called on the user's stack.            28130000
;                                                                       28135000
                                                                        28140000
if T(table'clean) then return;                                          28145000
                                                                        28150000
T(table'clean):=true;                                                   28155000
                                                                        28160000
mtds(T(table'dst),                     <<target'dseg'num>>              28165000
                                                                        28170000
     logical(integer(T(table'base)) +  <<target'offset>>                28175000
     integer(T(table'entry'size)) *                                     28180000
     integer(T(table'current'entry))),                                  28185000
                                                                        28190000
     T,                                <<source>>                       28195000
                                                                        28200000
     T(table'entry'size)               <<word'cnt>> );                  28205000
                                                                        28210000
if T(table'auto'sir) then                                               28215000
  relsir(T(table'sir), T(table'getsir'save));                           28220000
                                                                        28225000
end;  <<put'entry>>                                                     28230000
                                                                        28235000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   28240000
subroutine get'entry(T, index);                                         28245000
value                T, index ;                                         28250000
logical pointer      T        ;                                         28255000
integer                 index ;                                         28260000
begin                                                                   28265000
                                                                        28270000
COMMENT                                                                 28275000
                                                                        28280000
Special considerations:  Must be called on the user's stack.            28285000
;                                                                       28290000
                                                                        28295000
if not T(table'clean) then put'entry(T);                                28300000
                                                                        28305000
if T(table'auto'sir) then                                               28310000
  T(table'getsir'save):=getsir(T(table'sir));                           28315000
                                                                        28320000
mfds(T,                                <<target>>                       28325000
                                                                        28330000
     T(table'dst),                     <<source'dseg'num>>              28335000
                                                                        28340000
     logical(integer(T(table'base)) +  <<source'offset>>                28345000
     integer(T(table'entry'size)) *                                     28350000
     index),                                                            28355000
                                                                        28360000
     T(table'entry'size)               <<word'cnt>>);                   28365000
                                                                        28370000
T(table'current'entry):=index;                                          28375000
T(table'clean):=false;                                                  28380000
                                                                        28385000
end;  <<get'entry>>                                                     28390000
                                                                        28395000
$PAGE "PROCEDURE: CPR'COND'CHG'LDTX"                                    28400000
                                                                        28405000
  <<Open the ldt>>                                                      28410000
open'table(ldt, ldt'dst, 0 <<base>>, 1 <<type>>, ldt'sir, false);       28415000
                                                                        28420000
  <<Get the header entry>>                                              28425000
get'entry(ldt, 0);                                                      28430000
                                                                        28435000
  <<Open the ldtx with auto'sir locking>>                               28440000
open'table(ldtx, ldt'dst,                                      <<07425>>28445000
     LDTX'BASE <<base>>,                                       <<07425>>28450000
     1 <<type>>, ldt'sir, true);                               <<07425>>28455000
                                                                        28460000
  <<Get the entry of the ldev>>                                         28465000
get'entry(ldtx, ldev);                                                  28470000
                                                                        28475000
  <<Check to see if the ldev has been initialized for the CIPER         28480000
      protocol>>                                                        28485000
  <<Later a check should be made that it hasn't been initalized for     28490000
     some other type of protocol.>>                                     28495000
if not ldtx'ciper'protocol then                                <<07425>>28500000
                                                                        28505000
    <<The ldev hasn't been initialized for a CIPER device.>>            28510000
    <<Change the entry.>>                                               28515000
  begin                                                                 28520000
  ldtx'ciper'protocol := true;                                 <<07425>>28525000
  ldtx'ciper'cntl'dseg:= cdda'dseg;                            <<07425>>28530000
  ldtx'ciper'ct'map'index := ctmi;                             <<07425>>28535000
  end                                                                   28540000
                                                                        28545000
else                                                                    28550000
                                                                        28555000
    <<The ldev has been initialized as a CIPER device return the        28560000
       data segment to the system.>>                                    28565000
  reldataseg(cdda'dseg);                                                28570000
                                                                        28575000
  <<Put the ldtx entry of the ldev back.>>                              28580000
put'entry(ldtx);                                                        28585000
                                                                        28590000
end; <<cpr'cond'chg'ldtx>>                                              28595000
                                                                        28600000
        <<end of routines for cpr'init'cdda'for>>                       28605000
$PAGE "PROCEDURE: CPR'INIT'CDS'FOR"                                     28610000
logical procedure cpr'init'cds'for(ldev);                               28615000
                                                                        28620000
  value                            ldev ;                               28625000
                                                                        28630000
  integer                          ldev ;                               28635000
                                                                        28640000
  option privileged, uncallable;                                        28645000
                                                                        28650000
begin                                                                   28655000
                                                                        28660000
COMMENT                                                                 28665000
                                                                        28670000
Purpose:  Creates the "ciper data segment" for ldev.  Basically         28675000
this creates the data areas but does not fill in any CIPER functional   28680000
data.                                                                   28685000
                                                                        28690000
Input:                                                                  28695000
      ldev := the logical device for which the data area is created.    28700000
                                                                        28705000
Output:                                                                 28710000
      cpr'init'cds'for := if a data segment was successfully            28715000
initialized.                                                            28720000
                                                                        28725000
Side effects:  DB is exchanged to the base of the cds for this ldev.    28730000
;                                                                       28735000
                                                                        28740000
integer                                                                 28745000
        ctmi                                                            28750000
;                                                                       28755000
double                                                                  28760000
       cds'db                                                           28765000
;                                                                       28770000
logical pointer                                                         28775000
                ctm0                                                    28780000
               ,sha                                                     28785000
;                                                                       28790000
                                                                        28795000
if not cpr'get'cds(ldev) then                                           28800000
    <<unable to get a data segment>>                                    28805000
  begin                                                                 28810000
  cpr'init'cds'for := false;                                            28815000
  return;                                                               28820000
  end;                                                                  28825000
                                                                        28830000
@sha := sha'segment'offset;                                             28835000
                                                                        28840000
@ctm0 := sha(sha'ctm'ptr);                                              28845000
                                                                        28850000
ctmi := cpr'get'ctmi(ctm0, ldev);                                       28855000
if ctmi = 0 then                                                        28860000
  begin                                                                 28865000
  cpr'init'cds'for := false;                                            28870000
  return;                                                               28875000
  end;                                                                  28880000
                                                                        28885000
cpr'init'ct(ctmi);                                                      28890000
                                                                        28895000
  <<temporarily go back to the caller's stack>>                         28900000
cds'db := changedb( 0D );                                      <<07425>>28905000
                                                                        28910000
  <<test and conditionally set the ldtx>>                               28915000
cpr'cond'chg'ldtx(ldev, -integer( cds'db ), ctmi);                      28920000
                                                                        28925000
cpr'init'cds'for := true;                                               28930000
                                                                        28935000
end; <<cpr'init'cds'for>>                                               28940000
                                                                        28945000
      <<end of routines for cpr'get'ct'of>>                             28950000
$PAGE "PROCEDURE: CPR'GET'CT'OF"                                        28955000
integer procedure cpr'get'ct'of(ldev, callers'db);                      28960000
                                                                        28965000
  value                         ldev, callers'db ;                      28970000
                                                                        28975000
  integer                       ldev             ;                      28980000
                                                                        28985000
  double                              callers'db ;                      28990000
                                                                        28995000
  option privileged, uncallable;                                        29000000
                                                                        29005000
begin                                                                   29010000
                                                                        29015000
COMMENT                                                                 29020000
                                                                        29025000
Purpose: Checks for the presence of a control table for this            29030000
device, if none exists then cpr'init'cdda'of(ldev) is called.           29035000
DB is changed to the base of the cds.  The address of the ct is         29040000
computed and returned.  Currently an ciper validity check is            29045000
made on the ldev, and an interference check is made on the              29050000
ct(callers'db).                                                         29055000
                                                                        29060000
Input:                                                                  29065000
     ldev := the logical device for which the control table             29070000
address is being requested.                                             29075000
                                                                        29080000
Output:                                                                 29085000
     cpr'get'ct'of := the DB (i.e. cds) relative address of the         29090000
control table of this device.                                           29095000
                                                                        29100000
Side effects:                                                           29105000
     DB is changed to the base of the cds for ldev.  The                29110000
caller's db location is saved in ct'd(ct'd'callers'db).                 29115000
;                                                                       29120000
                                                                        29125000
logical pointer <<for LOCAL copy of MPE tables>>               <<07425>>29130000
                ldt                                            <<07425>>29135000
               ,ldtx                                                    29140000
;                                                                       29145000
logical pointer                                                         29150000
                ct                                                      29155000
               ,ctm                                                     29160000
               ,ctm0                                                    29165000
               ,sha                                                     29170000
;                                                                       29175000
double pointer                                                          29180000
               ct'd            = ct                                     29185000
;                                                                       29190000
logical                                                                 29195000
        ctmi                                                            29200000
       ,debugging                                                       29205000
;                                                                       29210000
                                                                        29215000
                                                               <<07425>>29220000
integer                                                        <<07425>>29225000
        ldtx'index := 0 << Must be zero. >>                    <<07425>>29230000
;                                                              <<07425>>29235000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            29240000
equate                                                                  29245000
       table'entry'data    = 0                                          29250000
      ,table'entry'size    = -1 + table'entry'data                      29255000
      ,table'status        = -1 + table'entry'size                      29260000
      ,table'current'entry = -1 + table'status                          29265000
      ,table'base          = -1 + table'current'entry                   29270000
      ,table'dst           = -1 + table'base                            29275000
      ,table'sir           = -1 + table'dst                             29280000
      ,table'overhead      = -table'sir                                 29285000
;                                                                       29290000
define                                                                  29295000
       table'clean         = table'status).(0:1 #                       29300000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               29305000
      ,table'auto'sir      = table'status).(1:1 #                       29310000
      ,table'getsir'save   = table'status).(2:2 #                       29315000
      ,table'type          = table'status).(13:3 #                      29320000
;                                                                       29325000
                                                                        29330000
$PAGE "UTILITY SUBROUTINE: MFDS"                                        29335000
Subroutine mfds(target, source'dseg'num, source'offset, word'cnt);      29340000
value           target, source'dseg'num, source'offset, word'cnt ;      29345000
logical pointer target                                           ;      29350000
logical                 source'dseg'num, source'offset, word'cnt ;      29355000
begin                                                                   29360000
                                                                        29365000
  assemble(stax; mfds 0; ldxa);                                         29370000
                                                                        29375000
end; <<mfds>>                                                           29380000
                                                                        29385000
                                                                        29390000
$PAGE "UTILITY SUBROUTINE: MTDS"                                        29395000
Subroutine mtds(target'dseg'num, target'offset, source, word'cnt);      29400000
value           target'dseg'num, target'offset, source, word'cnt ;      29405000
logical         target'dseg'num, target'offset,         word'cnt ;      29410000
logical pointer                                 source           ;      29415000
begin                                                                   29420000
                                                                        29425000
  assemble(stax; mtds 0; ldxa);                                         29430000
                                                                        29435000
end; <<mtds>>                                                           29440000
                                                                        29445000
                                                                        29450000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  29455000
subroutine open'table(T, dst, base, type, sir, auto'sir);               29460000
value                    dst, base, type, sir, auto'sir ;               29465000
logical pointer       T                                 ;               29470000
integer                  dst, base, type, sir           ;               29475000
logical                                        auto'sir ;               29480000
begin                                                 <<sxit return>>   29485000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           29490000
                                                                        29495000
COMMENT                                                                 29500000
                                                                        29505000
Purpose:                                                                29510000
                                                                        29515000
Error reporting:                                                        29520000
                                                                        29525000
External references:                                                    29530000
                                                                        29535000
Input:                                                                  29540000
                                                                        29545000
Output:                                                                 29550000
                                                                        29555000
Side effects:                                                           29560000
                                                                        29565000
Special considerations:  Must be called on the user's stack.            29570000
;                                                                       29575000
                                                                        29580000
  <<make some space on the stack directly under the calling             29585000
    parameters for the table'overhead area of table T of size           29590000
    table'overhead.>>                                                   29595000
assemble(lra s-0                                                        29600000
        ;stax                                                           29605000
        ;adds table'overhead <<the amount of space needed>>             29610000
        ;lra s-0  <<destination address>>                               29615000
        ;ldxa  <<source address>>                                       29620000
        ;ldni 7 <<the negative count of the parameter                   29625000
                  list size plus the return address  >>                 29630000
        ;move                                                           29635000
);                                                                      29640000
                                                                        29645000
  <<set the address of the table>>                                      29650000
assemble(lra s-6                                                        29655000
        ;stax                                                           29660000
);                                                                      29665000
@T:=x;                                                                  29670000
                                                                        29675000
  <<initialize the table's control area>>                               29680000
T(table'sir):=sir;                                                      29685000
T(table'dst):=dst;                                                      29690000
T(table'base):=base;                                                    29695000
T(table'current'entry):=0;                                              29700000
                                                                        29705000
  << T(table'status) variable >>                                        29710000
T(table'status) := 0;                                                   29715000
T(table'clean):=true;                                                   29720000
T(table'auto'sir):=auto'sir;                                            29725000
T(table'getsir'save):=0;                                                29730000
T(table'type):=type;                                                    29735000
                                                                        29740000
  << T(table'entry'size) >>                                             29745000
                                                               <<07425>>29750000
<< Extract the number of words in the entry for the >>         <<07425>>29755000
<< move from the extra data segment to the stack.   >>         <<07425>>29760000
<< If the table type is 0 then the entry size is    >>         <<07425>>29765000
<< already in the overhead area, else extract the   >>         <<07425>>29770000
<< count from word 1 of the zero'th entry.          >>         <<07425>>29775000
IF T(TABLE'TYPE) <> 0                                          <<07425>>29780000
   THEN                                                        <<07425>>29785000
      BEGIN                                                    <<07425>>29790000
      MFDS(T(TABLE'ENTRY'SIZE),  << TARGET WORD >>             <<07425>>29795000
           T(TABLE'DST),         << SOURCE DST # >>            <<07425>>29800000
           T(TABLE'BASE)+1,      << SOURCE OFFSET INTO XDS >>  <<07425>>29805000
           1);                   << COUNT >>                   <<07425>>29810000
      END;                                                     <<07425>>29815000
                                                               <<07425>>29820000
                                                               <<07425>>29825000
                                                                        29830000
  <<make some space on the stack directly under the calling             29835000
    parameters for the table'entry'data of size                         29840000
    = table(table'entry'size).>>                                        29845000
x:=T(table'entry'size);                                                 29850000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      29855000
                the return address in x.>>                              29860000
        ;adds 0 <<add the space to the stack.>>                         29865000
        ;ldxa  <<put the return address on the stack.>>                 29870000
);                                                                      29875000
                                                                        29880000
end;  <<open'table>>                                                    29885000
                                                                        29890000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   29895000
subroutine put'entry(T);                                                29900000
value                T ;                                                29905000
logical pointer      T ;                                                29910000
begin                                                                   29915000
                                                                        29920000
COMMENT                                                                 29925000
                                                                        29930000
Special considerations:  Must be called on the user's stack.            29935000
;                                                                       29940000
                                                                        29945000
if T(table'clean) then return;                                          29950000
                                                                        29955000
T(table'clean):=true;                                                   29960000
                                                                        29965000
mtds(T(table'dst),                     <<target'dseg'num>>              29970000
                                                                        29975000
     logical(integer(T(table'base)) +  <<target'offset>>                29980000
     integer(T(table'entry'size)) *                                     29985000
     integer(T(table'current'entry))),                                  29990000
                                                                        29995000
     T,                                <<source>>                       30000000
                                                                        30005000
     T(table'entry'size)               <<word'cnt>> );                  30010000
                                                                        30015000
if T(table'auto'sir) then                                               30020000
  relsir(T(table'sir), T(table'getsir'save));                           30025000
                                                                        30030000
end;  <<put'entry>>                                                     30035000
                                                                        30040000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   30045000
subroutine get'entry(T, index);                                         30050000
value                T, index ;                                         30055000
logical pointer      T        ;                                         30060000
integer                 index ;                                         30065000
begin                                                                   30070000
                                                                        30075000
COMMENT                                                                 30080000
                                                                        30085000
Special considerations:  Must be called on the user's stack.            30090000
;                                                                       30095000
                                                                        30100000
if not T(table'clean) then put'entry(T);                                30105000
                                                                        30110000
if T(table'auto'sir) then                                               30115000
  T(table'getsir'save):=getsir(T(table'sir));                           30120000
                                                                        30125000
mfds(T,                                <<target>>                       30130000
                                                                        30135000
     T(table'dst),                     <<source'dseg'num>>              30140000
                                                                        30145000
     logical(integer(T(table'base)) +  <<source'offset>>                30150000
     integer(T(table'entry'size)) *                                     30155000
     index),                                                            30160000
                                                                        30165000
     T(table'entry'size)               <<word'cnt>>);                   30170000
                                                                        30175000
T(table'current'entry):=index;                                          30180000
T(table'clean):=false;                                                  30185000
                                                                        30190000
end;  <<get'entry>>                                                     30195000
                                                                        30200000
$PAGE "PROCEDURE: CPR'GET'CT'OF"                                        30205000
    <<open the ldt>>                                                    30210000
  open'table(ldt,  ldt'dst, 0 << base >>, 1 << table'type >>,  <<07425>>30215000
       ldt'sir, false << auto'sir >> );                                 30220000
                                                                        30225000
    <<get the header entry>>                                            30230000
  get'entry(ldt,  0);                                          <<07425>>30235000
                                                                        30240000
    <<open the ldtx>>                                                   30245000
  open'table(ldtx, ldt'dst, ldtx'base << base >>,              <<07425>>30250000
       1 << table'type >>, ldt'sir, false << auto'sir >> );    <<07425>>30255000
                                                                        30260000
    <<get the entry of the ldev>>                                       30265000
  get'entry(ldtx, ldev);                                                30270000
                                                                        30275000
  if not ldtx'ciper'protocol then                              <<07425>>30280000
      <<no data segment allocated yet (i.e. must initialize)>>          30285000
    begin                                                               30290000
                                                                        30295000
    if not cpr'init'cds'for(ldev) then                                  30300000
        <<no data segment available>>                                   30305000
      go to error'exit;                                                 30310000
                                                                        30315000
      <<update the local copy of the ldtx for this ldev>>               30320000
    ldtx(table'clean) := true; <<disarm put'entry>>                     30325000
    get'entry(ldtx, ldev);                                              30330000
                                                                        30335000
    end;                                                                30340000
                                                                        30345000
  if ldtx'ciper'shut'down then                                 <<07425>>30350000
       << a cpr'shutdown type of error has occured in the    >>         30355000
    << ciper subsystem for this device, no more transctions  >>         30360000
    << can take place until the ciper subsystem for this     >>         30365000
    << device is reinitialized. >>                                      30370000
    go to error'exit;                                                   30375000
                                                                        30380000
    <<get a local copy of ctmi>>                                        30385000
  ctmi := ldtx'ciper'ct'map'index;                             <<07425>>30390000
                                                                        30395000
    <<get a local copy of the debugging flag>>                          30400000
  debugging := ldtx'ciper'debug;                               <<07425>>30405000
                                                                        30410000
    <<change DB to data segment>>                                       30415000
  changedb( double( -integer( ldtx'ciper'cntl'dseg ) ) );      <<07425>>30420000
                                                                        30425000
    <<find @ct>>                                                        30430000
  @sha:=sha'segment'offset;                                             30435000
  @ctm0:=sha(sha'ctm'ptr);                                              30440000
                                                                        30445000
  @ctm:=@ctm0(ctm0(ctm0'ctm'size) * ctmi);                              30450000
                                                                        30455000
  @ct:=ctm(ctm'ct'ptr);                                                 30460000
                                                                        30465000
  cpr'lock'cds'area(ct);                                                30470000
                                                                        30475000
    << check that this is the correct ldev >>                           30480000
  cpr'assertion( integer(ctm(ctm'ldev)) = ldev );                       30485000
                                                                        30490000
    << check that no one else is using this device now! >>              30495000
  cpr'assertion( ct'd(ct'd'callers'db) = nul'db );                      30500000
                                                                        30505000
    << check that ciper isn't executing any level >>                    30510000
  cpr'assertion( ct(ct'lvl'active) = 0 );                               30515000
                                                                        30520000
  ct'd(ct'd'callers'db) := callers'db;                                  30525000
                                                                        30530000
  CT(CT'CALLERS'STK) :=                                        <<07425>>30535000
        LPCB(CURPRC + STKINFOWORDNUM).STKDSTFIELD;             <<07425>>30540000
                                             << stk dst # >>            30545000
                                                                        30550000
  mfds( ct(ct'callers'stk'db), ct(ct'callers'stk), 1, 1);               30555000
                                                                        30560000
  cpr'get'ct'of := if debugging then -@ct else @ct;                     30565000
                                                                        30570000
return;                                                                 30575000
                                                                        30580000
error'exit:                                                             30585000
                                                                        30590000
  cpr'get'ct'of := 0; << indicates an error occured >>                  30595000
                                                                        30600000
  changedb( callers'db ); << get back to where we came in on >><<07425>>30605000
                                                                        30610000
end; <<cpr'get'ct'of>>                                                  30615000
                                                                        30620000
$PAGE "PROCEDURE: CPR'CB'OF"                                            30625000
integer procedure cpr'cb'of(ct, level);                                 30630000
                                                                        30635000
  value                     ct, level ;                                 30640000
                                                                        30645000
  logical pointer           ct        ;                                 30650000
                                                                        30655000
  integer                       level ;                                 30660000
                                                                        30665000
  option privileged, uncallable;                                        30670000
                                                                        30675000
begin                                                                   30680000
                                                                        30685000
COMMENT                                                                 30690000
                                                                        30695000
Purpose: Get the cds relative address of the control block              30700000
from the given control table for an CIPER internal                      30705000
implementation level.                                                   30710000
                                                                        30715000
Error reporting: cpr'internal'error is called if level is invalid.      30720000
                                                                        30725000
External references:                                                    30730000
                     cpr'internal'error                                 30735000
                                                                        30740000
Input:                                                                  30745000
     ct := the cds relative pointer of the control table.               30750000
     level := the CIPER implementation level for which the control      30755000
block address is being requested.  If the level isn't valid then        30760000
cpr'internal'error is called.                                           30765000
                                                                        30770000
Output:                                                                 30775000
     cpr'cb'of := the cds relative address of the control block         30780000
from ct and for the level specified.                                    30785000
                                                                        30790000
Side effects:  ct(ct'lvl'active) (i.e. the level currently active       30795000
of ciper'engine) is set to level.                                       30800000
                                                                        30805000
Special considerations:  Must be called with DB at the cds.             30810000
;                                                                       30815000
                                                                        30820000
$PAGE                                                                   30825000
                                                                        30830000
if not ( 1 <= level <= integer(ct(ct'lvl'cnt)) ) then                   30835000
  cpr'internal'error;                                                   30840000
                                                                        30845000
ct(ct'lvl'active) := level;                                             30850000
                                                                        30855000
cpr'cb'of := ct(ct'lvln'cb'ptr + level);                                30860000
                                                                        30865000
end; <<cpr'cb'of>>                                                      30870000
                                                                        30875000
$PAGE "PROCEDURE: CPR'REL'CT"                                           30880000
procedure cpr'rel'ct(ct, callers'db);                                   30885000
                                                                        30890000
  value              ct, callers'db ;                                   30895000
                                                                        30900000
  logical pointer    ct             ;                                   30905000
                                                                        30910000
  double                 callers'db ;                                   30915000
                                                                        30920000
  option privileged, uncallable;                                        30925000
                                                                        30930000
begin                                                                   30935000
                                                                        30940000
COMMENT                                                                 30945000
                                                                        30950000
Purpose: DB is changed back to the caller's original data segment.      30955000
                                                                        30960000
Input:                                                                  30965000
     ct := the pointer to the ct which is to be released.               30970000
                                                                        30975000
Output:                                                                 30980000
                                                                        30985000
Side effects:  DB is changed back to the caller's original data         30990000
segment.                                                                30995000
;                                                                       31000000
                                                                        31005000
double pointer                                                          31010000
               ct'd            = ct                                     31015000
;                                                                       31020000
                                                                        31025000
ct(ct'lvl'active) := 0;                                                 31030000
                                                                        31035000
ct'd(ct'd'callers'db) := nul'db;                                        31040000
ct(ct'callers'stk) := 0;                                                31045000
ct(ct'callers'stk'db) := 0;                                             31050000
                                                                        31055000
cpr'unlock'cds'area(ct);                                                31060000
                                                                        31065000
changedb(callers'db);                                          <<07425>>31070000
                                                                        31075000
end; <<cpr'rel'ct>>                                                     31080000
                                                                        31085000
    <<Include file for communication queue routines>>                   31090000
$PAGE "PROCEDURE: T'DELINK'SON'DOWN"                                    31095000
procedure t'delink'son'down(father, end'ptr, son, next'son'ptr);        31100000
                                                                        31105000
  value                     father, end'ptr, son, next'son'ptr ;        31110000
                                                                        31115000
  logical pointer           father,          son               ;        31120000
                                                                        31125000
  integer                           end'ptr,      next'son'ptr ;        31130000
                                                                        31135000
  option privileged, uncallable;                                        31140000
                                                                        31145000
begin                                                                   31150000
                                                                        31155000
if end'ptr <> nil then                                                  31160000
  if @father <> nil then                                                31165000
    father(end'ptr) :=                                                  31170000
       if next'son'ptr <> nil and @son <> nil then                      31175000
         son(next'son'ptr)                                              31180000
       else                                                             31185000
         nil;                                                           31190000
                                                                        31195000
end; <<t'delink'son'down>>                                              31200000
                                                                        31205000
$PAGE "PROCEDURE: T'DELINK'SON'SIDE"                                    31210000
procedure t'delink'son'side(father, end2'ptr,                           31215000
                            son, side1'ptr, side2'ptr);                 31220000
                                                                        31225000
  value                     father, end2'ptr,                           31230000
                            son, side1'ptr, side2'ptr ;                 31235000
                                                                        31240000
  logical pointer           father,                                     31245000
                            son                       ;                 31250000
                                                                        31255000
  integer                           end2'ptr,                           31260000
                                 side1'ptr, side2'ptr ;                 31265000
                                                                        31270000
  option privileged, uncallable;                                        31275000
                                                                        31280000
begin                                                                   31285000
                                                                        31290000
logical pointer                                                         31295000
                end2            <<secondary end pointer>>               31300000
               ,side1           <<primary side pointer>>                31305000
               ,side2           <<secondary side pointer>>              31310000
;                                                                       31315000
                                                                        31320000
if side2'ptr <> nil then                                                31325000
  if side1'ptr <> nil then                                              31330000
    begin                                                               31335000
    @side1 := son(side1'ptr);                                           31340000
    side1(side2'ptr) := nil;                                            31345000
    end                                                                 31350000
  else                                                                  31355000
    if end2'ptr <> nil then                                             31360000
      begin                                                             31365000
      @end2 := father(end2'ptr);                                        31370000
      if @end2 <> nil then                                              31375000
        begin                                                           31380000
        @side2 := @end2;                                                31385000
        while integer( side2( side2'ptr ) ) <> @son do                  31390000
          @side2 := side2(side2'ptr);                                   31395000
        side2(side2'ptr) := nil;                                        31400000
        end;                                                            31405000
      end;                                                              31410000
                                                                        31415000
end; <<t'delink'son'side>>                                              31420000
                                                                        31425000
$PAGE "PROCEDURE: T'DELINK'SON'UP"                                      31430000
procedure t'delink'son'up(son, father'ptr);                             31435000
                                                                        31440000
  value                   son, father'ptr ;                             31445000
                                                                        31450000
  logical pointer         son             ;                             31455000
                                                                        31460000
  integer                      father'ptr ;                             31465000
                                                                        31470000
  option privileged, uncallable;                                        31475000
                                                                        31480000
begin                                                                   31485000
                                                                        31490000
if father'ptr <> nil then                                               31495000
  son(father'ptr) := nil;                                               31500000
                                                                        31505000
end; <<t'delink'son'up>>                                                31510000
                                                                        31515000
$PAGE "PROCEDURE: T'LINK'SON'DOWN"                                      31520000
procedure t'link'son'down(father, end'ptr, new'son);                    31525000
                                                                        31530000
  value                   father, end'ptr, new'son ;                    31535000
                                                                        31540000
  logical pointer         father,          new'son ;                    31545000
                                                                        31550000
  integer                         end'ptr          ;                    31555000
                                                                        31560000
  option privileged, uncallable;                                        31565000
                                                                        31570000
begin                                                                   31575000
                                                                        31580000
if end'ptr <> nil then                                                  31585000
  if father(end'ptr) = nil then                                         31590000
    father(end'ptr) := @new'son;                                        31595000
                                                                        31600000
end; <<t'link'son'down>>                                                31605000
                                                                        31610000
$PAGE "PROCEDURE: T'LINK'SON'SIDE"                                      31615000
procedure t'link'son'side(father, end1'ptr, end2'ptr,                   31620000
                          new'son, side1'ptr         );                 31625000
                                                                        31630000
  value                   father, end1'ptr, end2'ptr,                   31635000
                          new'son, side1'ptr          ;                 31640000
                                                                        31645000
  logical pointer         father,                                       31650000
                          new'son                     ;                 31655000
                                                                        31660000
  integer                         end1'ptr, end2'ptr,                   31665000
                                   side1'ptr          ;                 31670000
                                                                        31675000
  option privileged, uncallable;                                        31680000
                                                                        31685000
begin                                                                   31690000
                                                                        31695000
logical pointer                                                         31700000
                end1 <<primary end pointer>>                            31705000
               ,end2 <<secondary end pointer>>                          31710000
               ,side1 <<primary side pointer>>                          31715000
;                                                                       31720000
                                                                        31725000
if side1'ptr <> nil then                                                31730000
  if end1'ptr <> nil then                                               31735000
    begin                                                               31740000
    @end1 := father(end1'ptr);                                          31745000
    end1(side1'ptr) := @new'son;                                        31750000
    end                                                                 31755000
  else                                                                  31760000
    if end2'ptr <> nil then                                             31765000
      begin                                                             31770000
      @end2 := father(end2'ptr);                                        31775000
      if @end2 <> nil then                                              31780000
        begin                                                           31785000
        @end1 := @end2;                                                 31790000
        while end1(side1'ptr) <> nil do                                 31795000
          @end1 := end1(side1'ptr);                                     31800000
        end2(side1'ptr) := @new'son;                                    31805000
        end;                                                            31810000
      end;                                                              31815000
                                                                        31820000
end; <<t'link'son'side>>                                                31825000
                                                                        31830000
$PAGE "PROCEDURE: T'LINK'SON'UP"                                        31835000
procedure t'link'son'up(father, new'son, father'ptr);                   31840000
                                                                        31845000
  value                 father, new'son, father'ptr ;                   31850000
                                                                        31855000
  logical pointer       father, new'son             ;                   31860000
                                                                        31865000
  integer                                father'ptr ;                   31870000
                                                                        31875000
  option privileged, uncallable;                                        31880000
                                                                        31885000
begin                                                                   31890000
                                                                        31895000
if father'ptr <> nil then                                               31900000
  new'son(father'ptr) := @father;                                       31905000
                                                                        31910000
end; <<t'link'son'up>>                                                  31915000
                                                                        31920000
$PAGE "PROCEDURE: CPR'INIT'COMQ"                                        31925000
procedure cpr'init'comq(cb, number, size);                              31930000
                                                                        31935000
  value                 cb, number, size ;                              31940000
                                                                        31945000
  logical pointer       cb               ;                              31950000
                                                                        31955000
  integer                   number, size ;                              31960000
                                                                        31965000
  option privileged, uncallable;                                        31970000
                                                                        31975000
begin                                                                   31980000
                                                                        31985000
COMMENT                                                                 31990000
                                                                        31995000
Purpose:  Initializes the communication queue (comq) for a given        32000000
control block.                                                          32005000
;                                                                       32010000
                                                                        32015000
integer counter;                                                        32020000
                                                                        32025000
logical pointer                                                         32030000
                qe                                                      32035000
               ,qe'                                                     32040000
               ,qh                                                      32045000
;                                                                       32050000
                                                                        32055000
  <<get the queue header (qh)>>                                         32060000
@qh := cpr'get'cds'area(qh'size,                                        32065000
     (qh'suptype'def lor cb(cds'area'subtype)), 0);                     32070000
                                                                        32075000
  <<link the qh into the cb>>                                           32080000
cb(cb'qh'ptr) := @qh;                                                   32085000
                                                                        32090000
  <<compute the size of each qe>>                                       32095000
qh(qh'qe'size) := qe'size'min + size;                                   32100000
                                                                        32105000
cpr'assertion(number >= 0);                                             32110000
                                                                        32115000
qh(qh'free'cnt) := 0;                                                   32120000
                                                                        32125000
while integer(qh(qh'free'cnt)) <> number do                             32130000
  begin                                                                 32135000
                                                                        32140000
  @qe := cpr'get'cds'area(qh(qh'qe'size),                               32145000
       (qe'suptype'def lor cb(cds'area'subtype)), 0);                   32150000
                                                                        32155000
  @qe' := qh(qh'free'list'ptr);                                         32160000
                                                                        32165000
  qh(qh'free'list'ptr) := @qe;                                          32170000
                                                                        32175000
  qe(qe'next'free'ptr) := @qe';                                         32180000
                                                                        32185000
  qh(qh'free'cnt) := qh(qh'free'cnt) + 1;                               32190000
  end;                                                                  32195000
                                                                        32200000
end; <<cpr'init'comq>>                                                  32205000
                                                                        32210000
$PAGE "PROCEDURE: CPR'GET'QH'OF"                                        32215000
logical procedure cpr'get'qh'of(ct);                                    32220000
                                                                        32225000
  value                         ct ;                                    32230000
                                                                        32235000
  logical pointer               ct ;                                    32240000
                                                                        32245000
  option privileged, uncallable;                                        32250000
                                                                        32255000
begin                                                                   32260000
                                                                        32265000
COMMENT                                                                 32270000
                                                                        32275000
;                                                                       32280000
                                                                        32285000
logical pointer                                                         32290000
                cb                                                      32295000
;                                                                       32300000
                                                                        32305000
cpr'assertion( ct'suptype'def = ct(cds'area'suptype) );                 32310000
                                                                        32315000
@cb := ct(ct'lvl'active'ptr);                                           32320000
                                                                        32325000
cpr'get'qh'of := cb(cb'qh'ptr);                                         32330000
                                                                        32335000
end; <<cpr'get'qh'of>>                                                  32340000
                                                                        32345000
$PAGE "PROCEDURE: CPR'GET'QE"                                           32350000
logical procedure cpr'get'qe(ct);                                       32355000
                                                                        32360000
  value                      ct ;                                       32365000
                                                                        32370000
  logical pointer            ct ;                                       32375000
                                                                        32380000
  option privileged, uncallable;                                        32385000
                                                                        32390000
begin                                                                   32395000
                                                                        32400000
COMMENT                                                                 32405000
                                                                        32410000
Purpose:  Removes a comq from the free list.  Updates qh'free'cnt,      32415000
qh'inuse'cnt, and qh'max'inuse'cnt.                                     32420000
;                                                                       32425000
                                                                        32430000
logical pointer                                                         32435000
                qe                                                      32440000
               ,qh                                                      32445000
;                                                                       32450000
                                                                        32455000
@qh := cpr'get'qh'of(ct);                                               32460000
                                                                        32465000
cpr'lock'cds'area(qh);                                                  32470000
                                                                        32475000
  if qh(qh'free'list'ptr) = 0 then cpr'limit'error;                     32480000
                                                                        32485000
  @qe := qh(qh'free'list'ptr);                                          32490000
                                                                        32495000
  qh(qh'free'list'ptr) := qe(qe'next'free'ptr);                         32500000
                                                                        32505000
    <<adjust measurement data>>                                         32510000
  qh(qh'inuse'cnt) := qh(qh'inuse'cnt) + 1;                             32515000
                                                                        32520000
  qh(qh'free'cnt) := qh(qh'free'cnt) - 1;                               32525000
                                                                        32530000
  if qh(qh'inuse'cnt) > qh(qh'max'inuse'cnt) then                       32535000
    qh(qh'max'inuse'cnt) := qh(qh'inuse'cnt);                           32540000
                                                                        32545000
cpr'unlock'cds'area(qh);                                                32550000
                                                                        32555000
  <<clean out the comq 's control information>>                         32560000
qe  := 0;                                                               32565000
move qe(1) := qe, (qh(qh'qe'size) -1);                                  32570000
                                                                        32575000
  <<return the comq 's address>>                                        32580000
cpr'get'qe := @qe;                                                      32585000
                                                                        32590000
end; <<cpr'get'qe>>                                                     32595000
                                                                        32600000
$PAGE "PROCEDURE: CPR'REL'QE"                                           32605000
procedure cpr'rel'qe(ct, qe);                                           32610000
                                                                        32615000
  value              ct, qe ;                                           32620000
                                                                        32625000
  logical pointer    ct, qe ;                                           32630000
                                                                        32635000
  option privileged, uncallable;                                        32640000
                                                                        32645000
begin                                                                   32650000
                                                                        32655000
COMMENT                                                                 32660000
                                                                        32665000
;                                                                       32670000
logical pointer                                                         32675000
                qh                                                      32680000
;                                                                       32685000
                                                                        32690000
@qh := cpr'get'qh'of(ct);                                               32695000
                                                                        32700000
cpr'assertion( qh(cds'area'subtype) = qe(cds'area'subtype));            32705000
                                                                        32710000
cpr'lock'cds'area(qh);                                                  32715000
                                                                        32720000
  qe(qe'next'free'ptr) := qh(qh'free'list'ptr);                         32725000
                                                                        32730000
  qh(qh'free'list'ptr) := @qe;                                          32735000
                                                                        32740000
  qh(qh'free'cnt) := qh(qh'free'cnt) + 1;                               32745000
                                                                        32750000
  qh(qh'inuse'cnt) := qh(qh'inuse'cnt) - 1;                             32755000
                                                                        32760000
cpr'unlock'cds'area(qh);                                                32765000
                                                                        32770000
end; <<cpr'rel'qe>>                                                     32775000
                                                                        32780000
$PAGE "PROCEDURE: CPR'CQ'ADD'SON"                                       32785000
procedure cpr'cq'add'son(father, first'ptr, last'ptr,                   32790000
                         new'son, prev'ptr, next'ptr,                   32795000
                         father'ptr                  );                 32800000
                                                                        32805000
  value                  father, first'ptr, last'ptr,                   32810000
                         new'son, prev'ptr, next'ptr,                   32815000
                         father'ptr                   ;                 32820000
                                                                        32825000
  logical                father,                                        32830000
                         new'son                                        32835000
                                                      ;                 32840000
                                                                        32845000
  integer                        first'ptr, last'ptr,                   32850000
                                  prev'ptr, next'ptr,                   32855000
                         father'ptr                   ;                 32860000
                                                                        32865000
  option privileged, uncallable;                                        32870000
                                                                        32875000
begin                                                                   32880000
                                                                        32885000
  << Link the son as the last son's next brother link              >>   32890000
  << (i.e. the NEXT-LINK)                                          >>   32895000
t'link'son'side(father, last'ptr, nil,                                  32900000
                new'son,  next'ptr);                                    32905000
                                                                        32910000
  << Link the son as the father's last son.  (LAST-LINK)           >>   32915000
t'link'son'down(father, last'ptr, new'son);                             32920000
                                                                        32925000
  << Link the son as the father's first son.  (FIRST-LINK)         >>   32930000
t'link'son'down(father, first'ptr, new'son);                            32935000
                                                                        32940000
  << Link the father as the father of the son.  (FATHER-LINK)      >>   32945000
t'link'son'up(father, new'son, father'ptr);                             32950000
                                                                        32955000
end; <<cpr'cq'add'son>>                                                 32960000
                                                                        32965000
$PAGE "PROCEDURE: CPR'CQ'DEL'SON"                                       32970000
procedure cpr'cq'del'son(father, first'ptr, last'ptr,                   32975000
                         son, prev'ptr, next'ptr,                       32980000
                         father'ptr                  );                 32985000
                                                                        32990000
  value                  father, first'ptr, last'ptr,                   32995000
                         son, prev'ptr, next'ptr,                       33000000
                         father'ptr                   ;                 33005000
                                                                        33010000
  logical pointer        father,                                        33015000
                         son                                            33020000
                                                      ;                 33025000
                                                                        33030000
  integer                        first'ptr, last'ptr,                   33035000
                              prev'ptr, next'ptr,                       33040000
                         father'ptr                   ;                 33045000
                                                                        33050000
  option privileged, uncallable;                                        33055000
                                                                        33060000
begin                                                                   33065000
                                                                        33070000
  << Delink the son as the second son's previous brother.     >>        33075000
  << (i.e. the PREV-LINK)                                     >>        33080000
t'delink'son'side(father, last'ptr,                                     33085000
                  son, next'ptr, prev'ptr);                             33090000
                                                                        33095000
  << Delink the son as the father's first son. (FIRST-LINK)   >>        33100000
t'delink'son'down(father, first'ptr, son, next'ptr);                    33105000
                                                                        33110000
  << Delink the son as the father's last son. (LAST-LINK)     >>        33115000
t'delink'son'down(father, last'ptr, son, prev'ptr);                     33120000
                                                                        33125000
  << Delink the father as the father of the son. (FATHER-LINK)>>        33130000
t'delink'son'up(son, father'ptr);                                       33135000
                                                                        33140000
end; <<cpr'cq'del'son>>                                                 33145000
                                                                        33150000
$PAGE "PROCEDURE: CPR'REQUEST'TRANSMIT"                                 33155000
procedure cpr'request'transmit(ct, request'qe, father'qe);              33160000
                                                                        33165000
  value                        ct, request'qe, father'qe ;              33170000
                                                                        33175000
  logical pointer              ct, request'qe, father'qe ;              33180000
                                                                        33185000
  option privileged, uncallable;                                        33190000
                                                                        33195000
begin                                                                   33200000
                                                                        33205000
logical pointer                                                         33210000
                qh                                                      33215000
;                                                                       33220000
                                                                        33225000
@qh := cpr'get'qh'of(ct);                                               33230000
                                                                        33235000
cpr'lock'cds'area(qh);                                                  33240000
                                                                        33245000
    <<Add the request'qe to the comq relational (family) links.>>       33250000
  cpr'cq'add'son(father'qe, qe'head'son'ptr, qe'tail'son'ptr,           33255000
                  request'qe, qe'head'brother'ptr, qe'tail'brother'ptr, 33260000
                  qe'father'ptr);                                       33265000
                                                                        33270000
    <<Add the request'qe to the comq sequential (queue) links.>>        33275000
  cpr'cq'add'son(qh, qh'head'request'qe'ptr, qh'tail'request'qe'ptr,    33280000
                  request'qe, qe'head'qe'ptr, qe'tail'qe'ptr,           33285000
                  qe'qh'ptr);                                           33290000
                                                                        33295000
cpr'unlock'cds'area(qh);                                                33300000
                                                                        33305000
end; <<cpr'request'transmit>>                                           33310000
                                                                        33315000
$PAGE "PROCEDURE: CPR'REQUEST'RECEIVE"                                  33320000
logical procedure cpr'request'receive(ct);                              33325000
                                                                        33330000
  value                               ct ;                              33335000
                                                                        33340000
  logical pointer                     ct ;                              33345000
                                                                        33350000
  option privileged, uncallable;                                        33355000
                                                                        33360000
begin                                                                   33365000
                                                                        33370000
logical pointer                                                         33375000
                qh                                                      33380000
               ,request'qe                                              33385000
;                                                                       33390000
                                                                        33395000
@qh := cpr'get'qh'of(ct);                                               33400000
                                                                        33405000
cpr'lock'cds'area(qh);                                                  33410000
                                                                        33415000
  @request'qe := qh( qh'head'request'qe'ptr );                          33420000
                                                                        33425000
  if @request'qe <> nil then                                            33430000
                                                                        33435000
    cpr'cq'del'son(qh, qh'head'request'qe'ptr, qh'tail'request'qe'ptr,  33440000
                   request'qe, qe'head'qe'ptr, qe'tail'qe'ptr,          33445000
                   qe'qh'ptr);                                          33450000
                                                                        33455000
cpr'unlock'cds'area(qh);                                                33460000
                                                                        33465000
cpr'request'receive := @request'qe;                                     33470000
                                                                        33475000
end; <<cpr'request'receive>>                                            33480000
                                                                        33485000
$PAGE "PROCEDURE: CPR'RESPONSE'TRANSMIT"                                33490000
procedure cpr'response'transmit(response'qe);                           33495000
                                                                        33500000
  value                         response'qe ;                           33505000
                                                                        33510000
  logical pointer               response'qe ;                           33515000
                                                                        33520000
  option privileged, uncallable;                                        33525000
                                                                        33530000
begin                                                                   33535000
                                                                        33540000
logical pointer                                                         33545000
                qh                                                      33550000
;                                                                       33555000
                                                                        33560000
@qh := response'qe( qe'qh'ptr );                                        33565000
                                                                        33570000
cpr'lock'cds'area(qh);                                                  33575000
                                                                        33580000
     <<Add the response'qe to the comq sequential (queue) links.>>      33585000
  cpr'cq'add'son(qh, qh'head'response'qe'ptr, qh'tail'response'qe'ptr,  33590000
                 response'qe, qe'head'qe'ptr, qe'tail'qe'ptr,           33595000
                 nil);                                                  33600000
                                                                        33605000
cpr'unlock'cds'area(qh);                                                33610000
                                                                        33615000
end; <<cpr'response'transmit>>                                          33620000
                                                                        33625000
$PAGE "PROCEDURE: CPR'RESPONSE'RECEIVE"                                 33630000
logical procedure cpr'response'receive(ct);                             33635000
                                                                        33640000
  value                                ct ;                             33645000
                                                                        33650000
  logical pointer                      ct ;                             33655000
                                                                        33660000
  option privileged, uncallable;                                        33665000
                                                                        33670000
begin                                                                   33675000
                                                                        33680000
logical pointer                                                         33685000
                qh                                                      33690000
               ,response'qe                                             33695000
;                                                                       33700000
                                                                        33705000
@qh := cpr'get'qh'of(ct);                                               33710000
                                                                        33715000
cpr'lock'cds'area(qh);                                                  33720000
                                                                        33725000
  @response'qe := qh( qh'head'response'qe'ptr );                        33730000
                                                                        33735000
  if @response'qe <> nil then                                           33740000
                                                                        33745000
  cpr'cq'del'son(qh, qh'head'response'qe'ptr, qh'tail'response'qe'ptr,  33750000
                   response'qe, qe'head'qe'ptr, qe'tail'qe'ptr,         33755000
                   qe'qh'ptr);                                          33760000
                                                                        33765000
cpr'unlock'cds'area(qh);                                                33770000
                                                                        33775000
cpr'response'receive := @response'qe;                                   33780000
                                                                        33785000
end; <<cpr'response'receive>>                                           33790000
                                                                        33795000
                                                                        33800000
    <<end of routines for cpr'engine>>                                  33805000
<<$INCLUDE engine.B2608.OConnor <<cpr'engine>>                          33810000
                                                                        33815000
  <<generic routines called by each ciper level>>                       33820000
$PAGE "PROCEDURE: CPR'INIT'CBI"                                         33825000
integer procedure cpr'init'cbi(cb, size);                               33830000
                                                                        33835000
  value                        cb, size ;                               33840000
                                                                        33845000
  logical pointer              cb       ;                               33850000
                                                                        33855000
  integer                          size ;                               33860000
                                                                        33865000
  option privileged, uncallable;                                        33870000
                                                                        33875000
begin                                                                   33880000
                                                                        33885000
COMMENT                                                                 33890000
                                                                        33895000
Purpose: Create, initialize, and link a cbi into the cb.                33900000
                                                                        33905000
Input:                                                                  33910000
     cb := pointer to control block for which this cbi is for.          33915000
     size := size of the cbi.                                           33920000
                                                                        33925000
Output:                                                                 33930000
     cpr'init'cbi := pointer to the cbi.                                33935000
;                                                                       33940000
                                                                        33945000
logical pointer                                                         33950000
                cbi                                                     33955000
;                                                                       33960000
                                                                        33965000
if cb(cb'info'ptr) <> 0 then cpr'internal'error;                        33970000
                                                                        33975000
@cbi := cpr'get'cds'area(size,                                          33980000
     (cbi'suptype'def lor cb(cds'area'subtype)), 0);                    33985000
                                                                        33990000
cb(cb'info'ptr) := @cbi;                                                33995000
                                                                        34000000
cpr'init'cbi := @cbi;                                                   34005000
                                                                        34010000
end; <<cpr'init'cbi>>                                                   34015000
                                                                        34020000
$PAGE "PROCEDURE: CPR'INIT'CBIX"                                        34025000
integer procedure cpr'init'cbix(cb, size);                              34030000
                                                                        34035000
  value                         cb, size ;                              34040000
                                                                        34045000
  logical pointer               cb       ;                              34050000
                                                                        34055000
  integer                           size ;                              34060000
                                                                        34065000
  option privileged, uncallable;                                        34070000
                                                                        34075000
begin                                                                   34080000
                                                                        34085000
COMMENT                                                                 34090000
                                                                        34095000
Purpose: Create and initialize a cbix.                                  34100000
                                                                        34105000
Input:                                                                  34110000
     cb := pointer to control block for which this cbix is for.         34115000
     size := size of the cbix.                                          34120000
                                                                        34125000
Output:                                                                 34130000
     cpr'init'cbix := pointer to the cbix.                              34135000
;                                                                       34140000
                                                                        34145000
logical pointer                                                         34150000
                cbix                                                    34155000
;                                                                       34160000
                                                                        34165000
@cbix := cpr'get'cds'area(size,                                         34170000
     (cbix'suptype'def lor cb(cds'area'subtype)), 0);                   34175000
                                                                        34180000
cpr'init'cbix := @cbix;                                                 34185000
                                                                        34190000
end; <<cpr'init'cbix>>                                                  34195000
                                                                        34200000
$PAGE "PROCEDURE:  HASH'FUNCTION'CODE"                                  34205000
integer procedure b08'hash'function'code(function);                     34210000
                                                                        34215000
  value                                  function ;                     34220000
                                                                        34225000
  integer                                function ;                     34230000
                                                                        34235000
  option privileged, uncallable                   ;                     34240000
                                                                        34245000
                                                                        34250000
COMMENT                                                                 34255000
                                                                        34260000
  PURPOSE:                                                              34265000
                                                                        34270000
    This procedure will hash a disjoint set of file system              34275000
    function codes into a contiguous set of CIPER internal              34280000
    function codes.  A PB array is used as a hash table.  In            34285000
    the first pass, the table will be 256 words long, and will          34290000
    map one for one.  Later, a more sophisticated hashing al-           34295000
    gorithm will be incorporated to allow the size of the hash          34300000
    table to be reduced.                                                34305000
                                                                        34310000
                                                                        34315000
  INPUT PARAMETERS:                                                     34320000
                                                                        34325000
    FUNCTION, which is the file system function code passed to          34330000
      the logical driver.                                               34335000
                                                                        34340000
                                                                        34345000
  OUTPUT PARAMETERS:                                                    34350000
                                                                        34355000
    B08'HASH'FUNCTION'CODE, which is the compressed CIPER in-           34360000
      ternal function code.  A value of zero indicates the              34365000
      function input is not supported by the logical driver.            34370000
                                                                        34375000
                                                                        34380000
  SIDE-EFFECTS:                                                         34385000
                                                                        34390000
    None.                                                               34395000
                                                                        34400000
                                                                        34405000
  SPECIAL CONSIDERATIONS:                                               34410000
                                                                        34415000
    None.                                                               34420000
                                                                        34425000
                                                                        34430000
  CHANGE HISTORY:                                                       34435000
                                                                        34440000
    8/31/83  Chuck Mayne                                       <<07425>>34445000
                                                               <<07425>>34450000
    Added function codes 250 and 251 (enable logging and dis-  <<07425>>34455000
    able logging, respectfully).                               <<07425>>34460000
                                                                        34465000
                                                                        34470000
;                                                                       34475000
                                                                        34480000
begin                                                                   34485000
                                                                        34490000
$PAGE "FUNCTION CODE HASHING TABLE (PB ARRAY)"                          34495000
  integer array                                                         34500000
                                                                        34505000
    hash'table(0:255)             = PB :=                               34510000
                                                                        34515000
<<   0: >>    1   << read data >>                                       34520000
<<   1: >>   ,2   << write data >>                                      34525000
<<   2: >>   ,3   << fopen >>                                           34530000
<<   3: >>   ,4   << fclose >>                                          34535000
<<   4: >>   ,5   << device close >>                                    34540000
<<   5: >>   ,0                                                         34545000
<<   6: >>   ,0                                                         34550000
<<   7: >>   ,0                                                         34555000
<<   8: >>   ,0                                                         34560000
<<   9: >>   ,0                                                         34565000
<<  10: >>   ,0                                                         34570000
<<  11: >>   ,0                                                         34575000
<<  12: >>   ,0                                                         34580000
<<  13: >>   ,0                                                         34585000
<<  14: >>   ,0                                                         34590000
<<  15: >>   ,6   << device status immediate >>                         34595000
<<  16: >>   ,0                                                         34600000
<<  17: >>   ,0                                                         34605000
<<  18: >>   ,0                                                         34610000
<<  19: >>   ,0                                                         34615000
<<  20: >>   ,0                                                         34620000
<<  21: >>   ,0                                                         34625000
<<  22: >>   ,0                                                         34630000
<<  23: >>   ,0                                                         34635000
<<  24: >>   ,0                                                         34640000
<<  25: >>   ,0                                                         34645000
<<  26: >>   ,0                                                         34650000
<<  27: >>   ,0                                                         34655000
<<  28: >>   ,0                                                         34660000
<<  29: >>   ,0                                                         34665000
<<  30: >>   ,0                                                         34670000
<<  31: >>   ,0                                                         34675000
<<  32: >>   ,0                                                         34680000
<<  33: >>   ,0                                                         34685000
<<  34: >>   ,0                                                         34690000
<<  35: >>   ,0                                                         34695000
<<  36: >>   ,0                                                         34700000
<<  37: >>   ,0                                                         34705000
<<  38: >>   ,0                                                         34710000
<<  39: >>   ,0                                                         34715000
<<  40: >>   ,0                                                         34720000
<<  41: >>   ,0                                                         34725000
<<  42: >>   ,0                                                         34730000
<<  43: >>   ,0                                                         34735000
<<  44: >>   ,0                                                         34740000
<<  45: >>   ,0                                                         34745000
<<  46: >>   ,0                                                         34750000
<<  47: >>   ,0                                                         34755000
<<  48: >>   ,0                                                         34760000
<<  49: >>   ,0                                                         34765000
<<  50: >>   ,0                                                         34770000
<<  51: >>   ,0                                                         34775000
<<  52: >>   ,0                                                         34780000
<<  53: >>   ,0                                                         34785000
<<  54: >>   ,0                                                         34790000
<<  55: >>   ,0                                                         34795000
<<  56: >>   ,0                                                         34800000
<<  57: >>   ,0                                                         34805000
<<  58: >>   ,0                                                         34810000
<<  59: >>   ,0                                                         34815000
<<  60: >>   ,0                                                         34820000
<<  61: >>   ,0                                                         34825000
<<  62: >>   ,0                                                         34830000
<<  63: >>   ,0                                                         34835000
<<  64: >>   ,7   << vfu download >>                                    34840000
<<  65: >>   ,8   << set left margin >>                                 34845000
<<  66: >>   ,0                                                         34850000
<<  67: >>   ,0                                                         34855000
<<  68: >>   ,0                                                         34860000
<<  69: >>   ,0                                                         34865000
<<  70: >>   ,0                                                         34870000
<<  71: >>   ,9   << buffered device status >>                          34875000
<<  72: >>   ,0                                                         34880000
<<  73: >>   ,10  << self test >>                                       34885000
<<  74: >>   ,0                                                         34890000
<<  75: >>   ,0                                                         34895000
<<  76: >>   ,0                                                         34900000
<<  77: >>   ,0                                                         34905000
<<  78: >>   ,0                                                         34910000
<<  79: >>   ,0                                                         34915000
<<  80: >>   ,0                                                         34920000
<<  81: >>   ,0                                                         34925000
<<  82: >>   ,0                                                         34930000
<<  83: >>   ,0                                                         34935000
<<  84: >>   ,0                                                         34940000
<<  85: >>   ,0                                                         34945000
<<  86: >>   ,0                                                         34950000
<<  87: >>   ,0                                                         34955000
<<  88: >>   ,0                                                         34960000
<<  89: >>   ,0                                                         34965000
<<  90: >>   ,0                                                         34970000
<<  91: >>   ,0                                                         34975000
<<  92: >>   ,0                                                         34980000
<<  93: >>   ,0                                                         34985000
<<  94: >>   ,0                                                         34990000
<<  95: >>   ,0                                                         34995000
<<  96: >>   ,0                                                         35000000
<<  97: >>   ,0                                                         35005000
<<  98: >>   ,0                                                         35010000
<<  99: >>   ,0                                                         35015000
<< 100: >>   ,0                                                         35020000
<< 101: >>   ,0                                                         35025000
<< 102: >>   ,0                                                         35030000
<< 103: >>   ,0                                                         35035000
<< 104: >>   ,0                                                         35040000
<< 105: >>   ,0                                                         35045000
<< 106: >>   ,0                                                         35050000
<< 107: >>   ,0                                                         35055000
<< 108: >>   ,0                                                         35060000
<< 109: >>   ,0                                                         35065000
<< 110: >>   ,0                                                         35070000
<< 111: >>   ,0                                                         35075000
<< 112: >>   ,0                                                         35080000
<< 113: >>   ,0                                                         35085000
<< 114: >>   ,0                                                         35090000
<< 115: >>   ,0                                                         35095000
<< 116: >>   ,0                                                         35100000
<< 117: >>   ,0                                                         35105000
<< 118: >>   ,0                                                         35110000
<< 119: >>   ,0                                                         35115000
<< 120: >>   ,0                                                         35120000
<< 121: >>   ,0                                                         35125000
<< 122: >>   ,0                                                         35130000
<< 123: >>   ,0                                                         35135000
<< 124: >>   ,0                                                         35140000
<< 125: >>   ,0                                                         35145000
<< 126: >>   ,0                                                         35150000
<< 127: >>   ,0                                                         35155000
<< 128: >>   ,11  << select character set >>                            35160000
<< 129: >>   ,19                                                        35165000
<< 130: >>   ,19                                                        35170000
<< 131: >>   ,19                                                        35175000
<< 132: >>   ,19                                                        35180000
<< 133: >>   ,12  << define physical page length >>                     35185000
<< 134: >>   ,19                                                        35190000
<< 135: >>   ,19                                                        35195000
<< 136: >>   ,19                                                        35200000
<< 137: >>   ,19                                                        35205000
<< 138: >>   ,19                                                        35210000
<< 139: >>   ,19                                                        35215000
<< 140: >>   ,13  << page control >>                                    35220000
<< 141: >>   ,14  << clear environment >>                               35225000
<< 142: >>   ,15  << start job >>                                       35230000
<< 143: >>   ,16  << load default environment >>                        35235000
<< 144: >>   ,17  << download terminal debugging softkeys >>            35240000
<< 145: >>   ,18  << end job >>                                         35245000
<< 146: >>   ,23  << Set/Clear extended capability mode >>              35250000
<< 147: >>   ,24  << Start of block >>                                  35255000
<< 148: >>   ,25  << End of block >>                                    35260000
<< 149: >>   ,19                                                        35265000
<< 150: >>   ,19                                                        35270000
<< 151: >>   ,19                                                        35275000
<< 152: >>   ,19                                                        35280000
<< 153: >>   ,19                                                        35285000
<< 154: >>   ,19                                                        35290000
<< 155: >>   ,19                                                        35295000
<< 156: >>   ,19                                                        35300000
<< 157: >>   ,19                                                        35305000
<< 158: >>   ,19                                                        35310000
<< 159: >>   ,19                                                        35315000
<< 160: >>   ,19                                                        35320000
<< 161: >>   ,19                                                        35325000
<< 162: >>   ,19                                                        35330000
<< 163: >>   ,19                                                        35335000
<< 164: >>   ,19                                                        35340000
<< 165: >>   ,19                                                        35345000
<< 166: >>   ,19                                                        35350000
<< 167: >>   ,19                                                        35355000
<< 168: >>   ,19                                                        35360000
<< 169: >>   ,19                                                        35365000
<< 170: >>   ,19                                                        35370000
<< 171: >>   ,19                                                        35375000
<< 172: >>   ,19                                                        35380000
<< 173: >>   ,19                                                        35385000
<< 174: >>   ,19                                                        35390000
<< 175: >>   ,19                                                        35395000
<< 176: >>   ,19                                                        35400000
<< 177: >>   ,19                                                        35405000
<< 178: >>   ,19                                                        35410000
<< 179: >>   ,36  << job report buffered >>                    <<04422>>35415000
<< 180: >>   ,34  << environmental status immediate >>                  35420000
<< 181: >>   ,35  << device status composite >>                         35425000
<< 182: >>   ,30  << Flush out any buffers with data in them >>         35430000
<< 183: >>   ,31  << Erase any pending data in buffers >>               35435000
<< 184: >>   ,19                                                        35440000
<< 185: >>   ,28  << Set control mask >>                                35445000
<< 186: >>   ,29  << Return job report information >>                   35450000
<< 187: >>   ,26  << read status types available >>                     35455000
<< 188: >>   ,27  << set available status (configuration) >>            35460000
<< 189: >>   ,20  << device clear >>                                    35465000
<< 190: >>   ,21  << begin silent run >>                                35470000
<< 191: >>   ,22  << read environmental status >>                       35475000
<< 192: >>   ,19                                                        35480000
<< 193: >>   ,0                                                         35485000
<< 194: >>   ,0                                                         35490000
<< 195: >>   ,0                                                         35495000
<< 196: >>   ,0                                                         35500000
<< 197: >>   ,0                                                         35505000
<< 198: >>   ,0                                                         35510000
<< 199: >>   ,0                                                         35515000
<< 200: >>   ,0                                                         35520000
<< 201: >>   ,0                                                         35525000
<< 202: >>   ,0                                                         35530000
<< 203: >>   ,0                                                         35535000
<< 204: >>   ,0                                                         35540000
<< 205: >>   ,0                                                         35545000
<< 206: >>   ,0                                                         35550000
<< 207: >>   ,0                                                         35555000
<< 208: >>   ,0                                                         35560000
<< 209: >>   ,0                                                         35565000
<< 210: >>   ,0                                                         35570000
<< 211: >>   ,0                                                         35575000
<< 212: >>   ,0                                                         35580000
<< 213: >>   ,0                                                         35585000
<< 214: >>   ,0                                                         35590000
<< 215: >>   ,0                                                         35595000
<< 216: >>   ,0                                                         35600000
<< 217: >>   ,0                                                         35605000
<< 218: >>   ,0                                                         35610000
<< 219: >>   ,0                                                         35615000
<< 220: >>   ,0                                                         35620000
<< 221: >>   ,0                                                         35625000
<< 222: >>   ,0                                                         35630000
<< 223: >>   ,0                                                         35635000
<< 224: >>   ,0                                                         35640000
<< 225: >>   ,0                                                         35645000
<< 226: >>   ,0                                                         35650000
<< 227: >>   ,0                                                         35655000
<< 228: >>   ,0                                                         35660000
<< 229: >>   ,0                                                         35665000
<< 230: >>   ,0                                                         35670000
<< 231: >>   ,0                                                         35675000
<< 232: >>   ,0                                                         35680000
<< 233: >>   ,0                                                         35685000
<< 234: >>   ,0                                                         35690000
<< 235: >>   ,0                                                         35695000
<< 236: >>   ,0                                                         35700000
<< 237: >>   ,0                                                         35705000
<< 238: >>   ,0                                                         35710000
<< 239: >>   ,0                                                         35715000
<< 240: >>   ,0                                                         35720000
<< 241: >>   ,0                                                         35725000
<< 242: >>   ,0                                                         35730000
<< 243: >>   ,0                                                         35735000
<< 244: >>   ,0                                                         35740000
<< 245: >>   ,0                                                         35745000
<< 246: >>   ,0                                                         35750000
<< 247: >>   ,0                                                         35755000
<< 248: >>   ,0                                                         35760000
<< 249: >>   ,0                                                         35765000
<< 250: >>   ,37  << enable logging event >>                   <<07425>>35770000
<< 251: >>   ,38  << disable logging event >>                  <<07425>>35775000
<< 252: >>   ,0                                                         35780000
<< 253: >>   ,0                                                         35785000
<< 254: >>   ,33  << Test cpr'shutdown.  P1 := recursion level >>       35790000
<< 255: >>   ,32  << Set maximum record size.  P1 := size in bytes >>   35795000
                                                                        35800000
  ;  << end of hash'table >>                                            35805000
                                                                        35810000
                                                                        35815000
$PAGE "PROCEDURE:  B08'HASH'FUNCTION'CODE -- PROCEDURE BODY"            35820000
  if function < 0 or function > 255 then                                35825000
    begin                                                               35830000
      b08'hash'function'code := 0;                                      35835000
    end                                                                 35840000
  else                                                                  35845000
    begin                                                               35850000
      b08'hash'function'code := hash'table(function);                   35855000
    end;                                                                35860000
                                                                        35865000
end;  << of procedure b08'hash'function'code >>                         35870000
                                                                        35875000
  <<CIPER level 4>>                                                     35880000
$PAGE "PROCEDURE:  B08'NETWORK'PROTOCOL"                                35885000
double procedure b08'network'protocol(control'table, function,          35890000
                                      buffer, count, dst'num,           35895000
                                      ldev                   );         35900000
                                                                        35905000
  value                               control'table, function,          35910000
                                      buffer, count, dst'num,           35915000
                                      ldev                    ;         35920000
                                                                        35925000
  logical pointer                     control'table           ;         35930000
                                                                        35935000
  integer                                            function,          35940000
                                      buffer, count, dst'num,           35945000
                                      ldev                    ;         35950000
                                                                        35955000
  option privileged, uncallable                               ;         35960000
                                                                        35965000
                                                                        35970000
COMMENT                                                                 35975000
                                                                        35980000
  PURPOSE:                                                              35985000
                                                                        35990000
    This procedure performs the function of the CIPER trans-            35995000
    port end-to-end control (Level 4).  This includes initial-          36000000
    ization of the transport service, segmentation of Level 7           36005000
    records into packets for output, and recombination of               36010000
    packets into records for input to Level 7.  Since certain           36015000
    physical drivers require fopens, fcloses, and device closes         36020000
    be sent when allocating/deallocating a user, this procedure         36025000
    will pass those requests down to the physical drivers.              36030000
                                                                        36035000
                                                                        36040000
  INPUT PARAMETERS:                                                     36045000
                                                                        36050000
    CONTROL'TABLE, which points to the control table in the             36055000
      CIPER data segment that is allocated for this ldev.               36060000
                                                                        36065000
    FUNCTION, which is the command telling what to do this              36070000
      call.  At present, the following functions are supported          36075000
      by Level 4:                                                       36080000
                                                                        36085000
        0 --> read a record from the device                             36090000
        1 --> write a record to the device                              36095000
        2 --> pass an fopen to the physical driver                      36100000
        3 --> pass an fclose to the physical driver                     36105000
        4 --> pass a device close to the physical driver                36110000
        5 --> initialize the transport service                          36115000
        6 --> status request (currently not implemented)                36120000
                                                                        36125000
    ADDRESS, which points to the data buffer where read, write,         36130000
      and initialization data is to be found.                           36135000
                                                                        36140000
    COUNT, which is the size, in bytes, of the request data             36145000
      buffer.                                                           36150000
                                                                        36155000
    DST'NUM, which is the data segment number of the segment            36160000
      where the request buffer is located.                              36165000
                                                                        36170000
    LDEV, which is the logical device number the request is             36175000
      for.                                                              36180000
                                                                        36185000
                                                                        36190000
  OUTPUT PARAMETERS:                                                    36195000
                                                                        36200000
    B08'NETWORK'PROTOCOL, which is a double word function re-           36205000
      turn.  Word 0 is the completion status of the call.               36210000
      Word 1 is the transfer log, in bytes, of data moved               36215000
      to/from the caller.                                               36220000
                                                                        36225000
                                                                        36230000
  SIDE-EFFECTS:                                                         36235000
                                                                        36240000
    This procedure allocates a control block global area within         36245000
    the CIPER data segment of six words.  This global area              36250000
    is used to maintain information the procedure must have             36255000
    from call to call.                                                  36260000
                                                                        36265000
                                                                        36270000
  SPECIAL CONSIDERATIONS:                                               36275000
                                                                        36280000
    When called, this procedure expects DB to be set to the             36285000
    CIPER data segment.                                                 36290000
                                                                        36295000
                                                                        36300000
  CHANGE HISTORY:                                                       36305000
                                                                        36310000
    As issued.                                                          36315000
                                                                        36320000
                                                                        36325000
;                                                                       36330000
$PAGE "PROCEDURE:  B08'NETWORK'PROTOCOL -- LOCAL VARIABLES"             36335000
begin                                                                   36340000
                                                                        36345000
  double                                                                36350000
                                                                        36355000
    return'info                   = b08'network'protocol                36360000
      << Completion status of the call >>                               36365000
                                                                        36370000
  ;                                                                     36375000
                                                                        36380000
                                                                        36385000
  integer                                                               36390000
                                                                        36395000
    return'status                 = b08'network'protocol                36400000
      << Completion status >>                                           36405000
                                                                        36410000
   ,transfer'log                  = b08'network'protocol + 1            36415000
      << Total count of data moved to or from device >>                 36420000
                                                                        36425000
  ;                                                                     36430000
                                                                        36435000
                                                                        36440000
  integer pointer                                                       36445000
                                                                        36450000
    control'block                                                       36455000
      << points to control block for this level >>                      36460000
                                                                        36465000
   ,cbi                                                                 36470000
      << points to control block information area >>                    36475000
                                                                        36480000
   ,header'save'area                                                    36485000
      << points to area reserved by upper level for saving >>           36490000
      << the data where the packet headers must go.        >>           36495000
                                                                        36500000
   ,trailer'save'area                                                   36505000
      << points to area reserved by upper level(s) for    >>            36510000
      << saving the data which is in the trailer space.   >>            36515000
                                                                        36520000
   ,packet'header                                                       36525000
      << points to the zeroeth word of the current packet >>            36530000
      << header.                                          >>            36535000
                                                                        36540000
   ,packet'trailer                                                      36545000
      << points to the location where the packet trailer  >>            36550000
      << (if any) is to be placed.                        >>            36555000
                                                                        36560000
   ,address                                                             36565000
      << pointer to calling buffer >>                                   36570000
                                                                        36575000
  ;                                                                     36580000
                                                                        36585000
                                                                        36590000
  byte pointer                                                          36595000
                                                                        36600000
    start'of'data                                                       36605000
      << Points to first byte beyond the packet header >>               36610000
                                                                        36615000
   ,next'byte'of'record                                                 36620000
      << points to next available byte of record buffer >>              36625000
      << area during input                              >>              36630000
                                                                        36635000
  ;                                                                     36640000
                                                                        36645000
                                                                        36650000
  integer                                                               36655000
                                                                        36660000
    packet'number                                                       36665000
      << Keeps the packet sequence count.  Used for genera- >>          36670000
      << tion of packet sequence numbers on output and se-  >>          36675000
      << quence number checking on input.                   >>          36680000
                                                                        36685000
   ,transmit'count                                                      36690000
      << The size, in bytes, of the current packet trans-   >>          36695000
      << mission                                            >>          36700000
                                                                        36705000
   ,total'count                                                         36710000
      << The tally of all packet information sent or re-    >>          36715000
      << ceived.                                            >>          36720000
                                                                        36725000
   ,data'count                                                          36730000
      << Portion of a transfer that is user data (excludes >>           36735000
      << header/trailer data)                              >>           36740000
                                                                        36745000
  ;                                                                     36750000
                                                                        36755000
                                                                        36760000
  logical                                                               36765000
                                                                        36770000
    finished                                                            36775000
      << Set true when last packet has been sent or re- >>              36780000
      << ceived.                                        >>              36785000
                                                                        36790000
  ;                                                                     36795000
                                                                        36800000
                                                                        36805000
  << Control block information area (cbi) definitions: >>               36810000
                                                                        36815000
  equate                                                                36820000
                                                                        36825000
    lvl'2'header'size             = 0                                   36830000
      << size (in words) of header space needed by level 2 >>           36835000
                                                                        36840000
   ,lvl'2'trailer'size            = 1 + lvl'2'header'size               36845000
      << size (in words) of trailer space needed by level 2 >>          36850000
                                                                        36855000
   ,lvl'2'packet'size             = 1 + lvl'2'trailer'size              36860000
      << maximum size (in bytes) of packet that can handled >>          36865000
      << by the current physical link.                      >>          36870000
                                                                        36875000
   ,header'move'size              = 1 + lvl'2'packet'size               36880000
      << total size of space required for level 2 and level >>          36885000
      << 4 headers.                                         >>          36890000
                                                                        36895000
   ,trailer'move'size             = 1 + header'move'size                36900000
      << total size (in words) of space required for level 2 >>         36905000
      << and level 4 trailers.                               >>         36910000
                                                                        36915000
   ,initialized                   = 1 + trailer'move'size               36920000
      << set to true if the cbi has been properly initial-   >>         36925000
      << ized.                                              >>          36930000
                                                                        36935000
   ,level'4'cbi'size              = 1 + initialized                     36940000
      << Total CDS area required for the cbi >>                         36945000
                                                                        36950000
  ;                                                                     36955000
                                                                        36960000
                                                                        36965000
  << Definitions of Level 4 packet headers: >>                          36970000
                                                                        36975000
  define                                                                36980000
                                                                        36985000
    p'head'length                 = 0).(0:8 #                           36990000
      << Length (in bytes) of packet header.  Length in-   >>           36995000
      << clused the length byte itself.                    >>           37000000
                                                                        37005000
   ,p'reserved                    = 0).(8:7 #                           37010000
      << Reserved field within packet header.  Should be >>             37015000
      << set to zero.                                    >>             37020000
                                                                        37025000
   ,end'of'message'flag           = 0).(15:1 #                          37030000
      << When set, indicates last packet of a record >>                 37035000
                                                                        37040000
   ,sequence'number               = 1 #                                 37045000
      << Used for detecting missing or duplicated packets. >>           37050000
      << First packet of record is zero, increments by one >>           37055000
      << until end of message.                             >>           37060000
                                                                        37065000
   ,data'start                    = 2 #                                 37070000
      << Base of data contained in the packet >>                        37075000
                                                                        37080000
  ;                                                                     37085000
                                                                        37090000
                                                                        37095000
  << Constants associated with Level 4 headers/trailers: >>             37100000
                                                                        37105000
  equate                                                                37110000
                                                                        37115000
    lvl'4'header'size             = 2                                   37120000
      << Size (in words) of packet headers >>                           37125000
                                                                        37130000
   ,lvl'4'trailer'size            = 0                                   37135000
      << Currently no trailer is used >>                                37140000
                                                                        37145000
   ,lvl'4'overhead                = lvl'4'header'size                   37150000
                                  + lvl'4'trailer'size                  37155000
      << Total amount of space required >>                              37160000
                                                                        37165000
   ,b'lvl'4'header'size           = lvl'4'header'size * 2               37170000
                                                                        37175000
   ,b'lvl'4'trailer'size          = lvl'4'trailer'size * 2              37180000
                                                                        37185000
   ,b'lvl'4'overhead              = lvl'4'overhead * 2                  37190000
                                                                        37195000
  ;                                                                     37200000
                                                                        37205000
                                                                        37210000
  << Function requests made of Level 2 (physical drivers): >>           37215000
                                                                        37220000
  equate                                                                37225000
                                                                        37230000
    physical'read                 = 0                                   37235000
      << Requests a packet from the device >>                           37240000
                                                                        37245000
   ,physical'write                = 1                                   37250000
      << Transmits a packet to the device >>                            37255000
                                                                        37260000
   ,physical'open                 = 2                                   37265000
      << Allocates the physical link if necessary >>                    37270000
                                                                        37275000
   ,physical'close                = 3                                   37280000
      << Usually is a nop for the physical level >>                     37285000
                                                                        37290000
   ,physical'deallocate           = 4                                   37295000
      << Deallocates the physical link >>                               37300000
                                                                        37305000
   ,physical'initialize           = 184                                 37310000
      << Causes the physical driver to initialize and re- >>            37315000
      << port packet size, header, and trailer requirements >>          37320000
                                                                        37325000
  ;                                                                     37330000
$PAGE "PROCEDURE:  B08'NETWORK'PROTOCOL -- PROCEDURE BODY"              37335000
  << First, initialize the control block and cbi pointers >>            37340000
                                                                        37345000
  @control'block := cpr'cb'of(control'table, 4);                        37350000
                                                                        37355000
  @cbi := control'block(cb'info'ptr);                                   37360000
                                                                        37365000
                                                                        37370000
  << Initialize the buffer address pointer >>                           37375000
                                                                        37380000
  @address := buffer;                                                   37385000
                                                                        37390000
                                                                        37395000
  << If cbi is nil, then we have not yet initialized a    >>            37400000
  << control block information area.                      >>            37405000
                                                                        37410000
  if @cbi = nil then                                                    37415000
    begin                                                               37420000
      @cbi := cpr'init'cbi(control'block, level'4'cbi'size);            37425000
    end;                                                                37430000
                                                                        37435000
  if not logical( cbi(initialized) )                                    37440000
     and function <> transport'initialize then                          37445000
    begin                                                               37450000
      return'status := illegal'function'sequence;                       37455000
      return;                                                           37460000
    end;                                                                37465000
                                                                        37470000
                                                                        37475000
  << Make sure the function code is within range. >>                    37480000
                                                                        37485000
  if function < transport'read or function > transport'status           37490000
      then                                                              37495000
    begin                                                               37500000
      return'status := invalid'request;                                 37505000
      return;                                                           37510000
    end;                                                                37515000
                                                                        37520000
                                                                        37525000
  << Now select the appropriate thing to do >>                          37530000
                                                                        37535000
  case function of                                                      37540000
    begin                                                               37545000
                                                                        37550000
      begin  << function = 0  (transport'read) >>                       37555000
                                                                        37560000
        << Initialize certain variables >>                              37565000
                                                                        37570000
        packet'number := total'count := 0;                              37575000
                                                                        37580000
        @next'byte'of'record := @address to'byte;                       37585000
                                                                        37590000
                                                                        37595000
        << Bring in packets until the message is finished >>            37600000
                                                                        37605000
        do                                                              37610000
          begin                                                         37615000
                                                                        37620000
            << Calculate the read length >>                             37625000
                                                                        37630000
            transmit'count := if count < cbi(lvl'2'packet'size)         37635000
                then count                                              37640000
                else cbi(lvl'2'packet'size);                            37645000
                                                                        37650000
                                                                        37655000
            << If the transmit count is not large enough for >>         37660000
            << a packet with at least one byte of data, re-  >>         37665000
            << turn with an error.                           >>         37670000
                                                                        37675000
            if transmit'count < b'lvl'4'overhead + 1 then               37680000
              begin                                                     37685000
                return'status := fatal'error;                           37690000
                return;                                                 37695000
              end;                                                      37700000
                                                                        37705000
                                                                        37710000
            << Get a packet from the physical layer >>                  37715000
                                                                        37720000
            do                                                          37725000
                                                                        37730000
              return'info :=                                            37735000
                p'attachio( ldev,                                       37740000
                            0,                                          37745000
                            dst'num,                                    37750000
                            @address,                                   37755000
                            physical'read,                              37760000
                            -transmit'count,                            37765000
                            0,                                          37770000
                            0,                                          37775000
                            blocked   )                                 37780000
                                                                        37785000
            until return'status.overall <> system'powerfail;            37790000
                                                                        37795000
                                                                        37800000
            << Check the return status >>                               37805000
                                                                        37810000
            if return'status.general <> successful then                 37815000
              begin                                                     37820000
                transfer'log := total'count;                            37825000
                return;                                                 37830000
              end;                                                      37835000
                                                                        37840000
                                                                        37845000
            << Check the packet header for validity >>                  37850000
                                                                        37855000
            @packet'header := @address                                  37860000
                            + cbi(lvl'2'header'size);                   37865000
                                                                        37870000
            if packet'header(p'head'length)                             37875000
                < b'lvl'4'header'size                                   37880000
            or packet'header(sequence'number) <> packet'number          37885000
            then                                                        37890000
              begin                                                     37895000
                return'status := packet'sequence'error;                 37900000
                transfer'log := total'count;                            37905000
                return;                                                 37910000
              end                                                       37915000
            else                                                        37920000
              begin                                                     37925000
                                                                        37930000
                << Adjust the count of non-control data >>              37935000
                                                                        37940000
                data'count := -transfer'log                             37945000
                            - b'lvl'4'overhead;                         37950000
                                                                        37955000
                                                                        37960000
                << Increment the packet number for the next >>          37965000
                << packet, if any.                          >>          37970000
                                                                        37975000
                packet'number := packet'number + 1;                     37980000
                                                                        37985000
                << Check for last packet of message >>                  37990000
                                                                        37995000
                finished := logical(                                    38000000
                    packet'header(end'of'message'flag) );               38005000
                                                                        38010000
                                                                        38015000
                << Compress out the packet header >>                    38020000
                                                                        38025000
                @start'of'data := (@packet'header to'byte)              38030000
                                + packet'header(p'head'length);         38035000
                                                                        38040000
                move next'byte'of'record := start'of'data,              38045000
                    (data'count),2;                                     38050000
                                                                        38055000
                @next'byte'of'record := TOS;                            38060000
                                                                        38065000
                                                                        38070000
                << Update the total count of data received >>           38075000
                                                                        38080000
                total'count := total'count + data'count;                38085000
                                                                        38090000
                                                                        38095000
                << Move the base address up for the next  >>            38100000
                << packet, if any                         >>            38105000
                                                                        38110000
                @address := @address + ((data'count+1) to'word);        38115000
                                                                        38120000
                << Decrement the request count, since the   >>          38125000
                << free space in the buffer is shrinking.   >>          38130000
                                                                        38135000
                count := count - data'count;                            38140000
                                                                        38145000
              end;                                                      38150000
                                                                        38155000
            end                                                         38160000
          until finished;                                               38165000
                                                                        38170000
          transfer'log := total'count;                                  38175000
                                                                        38180000
                                                                        38185000
      end;   << of transport read >>                                    38190000
                                                                        38195000
                                                                        38200000
      begin  << function = 1  (transport'write) >>                      38205000
                                                                        38210000
        << Initialize the packet sequence counter and the  >>           38215000
        << pointers to save areas.                         >>           38220000
                                                                        38225000
        packet'number := total'count := 0;                              38230000
                                                                        38235000
        @header'save'area := @address - cbi(header'move'size);          38240000
                                                                        38245000
        @trailer'save'area := @address + ((count + 1) to'word);         38250000
                                                                        38255000
                                                                        38260000
        do                                                              38265000
          begin                                                         38270000
                                                                        38275000
            << Set up the pointer for this packet header >>             38280000
                                                                        38285000
            @packet'header := @address - lvl'4'header'size;             38290000
                                                                        38295000
                                                                        38300000
            << Determine how much of the request can be     >>          38305000
            << satisfied with this packet.                  >>          38310000
                                                                        38315000
            if count + b'lvl'4'overhead                                 38320000
                 > cbi(lvl'2'packet'size) then                          38325000
              begin                                                     38330000
                transmit'count := cbi(lvl'2'packet'size);               38335000
              end                                                       38340000
            else                                                        38345000
              begin                                                     38350000
                transmit'count := count + b'lvl'4'overhead;             38355000
              end;                                                      38360000
                                                                        38365000
                                                                        38370000
            << Data'count is set to be the portion of the  >>           38375000
            << transmit count that is the caller's data and >>          38380000
            << not headers/trailers.                        >>          38385000
                                                                        38390000
            data'count := transmit'count - b'lvl'4'overhead;            38395000
                                                                        38400000
                                                                        38405000
            << Decrement the request count by the amount we >>          38410000
            << will send this pass.                         >>          38415000
                                                                        38420000
            count := count - data'count;                                38425000
                                                                        38430000
                                                                        38435000
            << Move data out of the place where the packet  >>          38440000
            << header/trailer will be built.                >>          38445000
                                                                        38450000
            move header'save'area :=                                    38455000
                packet'header(-cbi(lvl'2'header'size)),                 38460000
                (cbi(header'move'size));                                38465000
                                                                        38470000
            if cbi(trailer'move'size) > 0 then                          38475000
              begin                                                     38480000
                @packet'trailer := @address                             38485000
                                 + ((data'count + 1) to'word);          38490000
                move trailer'save'area := packet'trailer,               38495000
                             (cbi(trailer'move'size));                  38500000
              end;                                                      38505000
                                                                        38510000
                                                                        38515000
            << Make the packet header. >>                               38520000
                                                                        38525000
            packet'header(p'head'length) := b'lvl'4'header'size;        38530000
                                                                        38535000
            packet'header(p'reserved) := 0;                             38540000
                                                                        38545000
            packet'header(end'of'message'flag) := count = 0;            38550000
                                                                        38555000
            packet'header(sequence'number) := packet'number;            38560000
                                                                        38565000
                                                                        38570000
            << Send the packet to the device >>                         38575000
                                                                        38580000
            do                                                          38585000
                                                                        38590000
              return'info :=                                            38595000
                p'attachio( ldev,                                       38600000
                            0,                                          38605000
                            dst'num,                                    38610000
                            @packet'header(-cbi(lvl'2'header'size)),    38615000
                            physical'write,                             38620000
                            -transmit'count,                            38625000
                            0,                                          38630000
                            0,                                          38635000
                            blocked  )                                  38640000
                                                                        38645000
            until return'status.overall <> system'powerfail;            38650000
                                                                        38655000
                                                                        38660000
            << Check the return status >>                               38665000
                                                                        38670000
            if return'status.general <> successful then                 38675000
              begin                                                     38680000
                count := 0;                                             38685000
              end;                                                      38690000
                                                                        38695000
                                                                        38700000
            << Bump up the packet counter for the next >>               38705000
            << packet, if any is to come.              >>               38710000
                                                                        38715000
            packet'number := packet'number + 1;                         38720000
                                                                        38725000
                                                                        38730000
            << Update the total transfer count, restore the >>          38735000
            << data to the packet header/trailer areas, and >>          38740000
            << adjust the address to point to the next      >>          38745000
            << packet, if any.                              >>          38750000
                                                                        38755000
            total'count := total'count + (-transfer'log                 38760000
                                          - b'lvl'4'overhead);          38765000
                                                                        38770000
            @address := @address + (data'count to'word);                38775000
                                                                        38780000
            move packet'header(-cbi(lvl'2'header'size)) :=              38785000
                 header'save'area,(cbi(header'move'size));              38790000
                                                                        38795000
            if cbi(trailer'move'size) > 0 then                          38800000
              begin                                                     38805000
                move packet'trailer := trailer'save'area,               38810000
                                  ( cbi(trailer'move'size) );           38815000
              end;                                                      38820000
                                                                        38825000
          end                                                           38830000
        until count = 0;                                                38835000
                                                                        38840000
        transfer'log := total'count;                                    38845000
                                                                        38850000
      end;  << of transport'write >>                                    38855000
                                                                        38860000
                                                                        38865000
                                                                        38870000
      begin  << function = 2  (transport'open) >>                       38875000
                                                                        38880000
        do                                                              38885000
          return'info :=                                                38890000
              p'attachio( ldev,                                         38895000
                          0,                                            38900000
                          dst'num,                                      38905000
                          0,                                            38910000
                          physical'open,                                38915000
                          0,                                            38920000
                          0,                                            38925000
                          0,                                            38930000
                          blocked  )                                    38935000
                                                                        38940000
        until return'status.overall <> system'powerfail;                38945000
                                                                        38950000
      end;  << of transport'open >>                                     38955000
                                                                        38960000
                                                                        38965000
                                                                        38970000
      begin  << function = 3  (transport'close) >>                      38975000
                                                                        38980000
        do                                                              38985000
          return'info :=                                                38990000
              p'attachio( ldev,                                         38995000
                          0,                                            39000000
                          dst'num,                                      39005000
                          0,                                            39010000
                          physical'close,                               39015000
                          0,                                            39020000
                          0,                                            39025000
                          0,                                            39030000
                          blocked  )                                    39035000
                                                                        39040000
        until return'status.overall <> system'powerfail;                39045000
                                                                        39050000
      end;  << of transport'close >>                                    39055000
                                                                        39060000
                                                                        39065000
                                                                        39070000
      begin  << function = 4  (transport'deallocate) >>                 39075000
                                                                        39080000
        do                                                              39085000
          return'info :=                                                39090000
              p'attachio( ldev,                                         39095000
                          0,                                            39100000
                          dst'num,                                      39105000
                          0,                                            39110000
                          physical'deallocate,                          39115000
                          0,                                            39120000
                          0,                                            39125000
                          0,                                            39130000
                          blocked  )                                    39135000
                                                                        39140000
        until return'status.overall <> system'powerfail;                39145000
                                                                        39150000
      end;  << of transport'deallocate >>                               39155000
                                                                        39160000
                                                                        39165000
                                                                        39170000
      begin  << function = 5  (transport'initialize) >>                 39175000
                                                                        39180000
        do                                                              39185000
                                                                        39190000
          return'info :=                                                39195000
            p'attachio( ldev,                                           39200000
                        0,                                              39205000
                        dst'num,                                        39210000
                        @cbi,                                           39215000
                        physical'initialize,                            39220000
                        3,                                              39225000
                        0,                                              39230000
                        0,                                              39235000
                        blocked  )                                      39240000
                                                                        39245000
        until return'status.overall <> system'powerfail;                39250000
                                                                        39255000
        << If the transport service reported a packet length >>         39260000
        << of zero, it really means there is no restriction. >>         39265000
        << Set the length to a very large even number, or,   >>         39270000
        << if the count was non-zero, round down to an even  >>         39275000
        << length.                                           >>         39280000
                                                                        39285000
        if cbi(lvl'2'packet'size) = 0 then                              39290000
          begin                                                         39295000
            cbi(lvl'2'packet'size) := 32766;                            39300000
          end                                                           39305000
        else                                                            39310000
          begin                                                         39315000
            cbi(lvl'2'packet'size).bit'15 := 0;                         39320000
          end;                                                          39325000
                                                                        39330000
                                                                        39335000
        << Move the header size, trailer size, and packet   >>          39340000
        << size of level 2 back to the upper levels.        >>          39345000
                                                                        39350000
        cbi(header'move'size) := cbi(lvl'2'header'size)                 39355000
                               + lvl'4'header'size;                     39360000
                                                                        39365000
        cbi(trailer'move'size) := cbi(lvl'2'trailer'size)               39370000
                                + lvl'4'trailer'size;                   39375000
                                                                        39380000
        address(lvl'2'header'size) := cbi(header'move'size);            39385000
                                                                        39390000
        address(lvl'2'trailer'size) := cbi(trailer'move'size);          39395000
                                                                        39400000
        address(lvl'2'packet'size) := cbi(lvl'2'packet'size);           39405000
                                                                        39410000
                                                                        39415000
        << Mark the cbi as initialized >>                               39420000
                                                                        39425000
        cbi(initialized) := true;                                       39430000
                                                                        39435000
                                                                        39440000
        << Tell them we returned three words >>                         39445000
                                                                        39450000
        transfer'log := 3;                                              39455000
                                                                        39460000
      end;  << of transport'initialize >>                               39465000
                                                                        39470000
                                                                        39475000
                                                                        39480000
      begin  << function = 6  (transport'status) >>                     39485000
                                                                        39490000
        << currently not implemented >>                                 39495000
                                                                        39500000
        return'status := successful;                                    39505000
                                                                        39510000
      end;                                                              39515000
                                                                        39520000
    end;  << of case function >>                                        39525000
                                                                        39530000
                                                                        39535000
end;  << of b08'network'protocol >>                                     39540000
                                                                        39545000
  << CIPER level 6 >>                                                   39550000
$PAGE "PROCEDURE: CPR'XLATE"                                            39555000
double  procedure cpr'xlate(poinr, sbuff, ebuff,                        39560000
                            func, p1, p2, ucn, presodd,xparency);       39565000
value                       poinr, sbuff, ebuff,                        39570000
                            func, p1, p2, ucn, presodd,xparency ;       39575000
logical                                                xparency         39580000
                                                                ;       39585000
integer pointer             poinr                                       39590000
                                                                ;       39595000
integer                                                                 39600000
                            func, p1, p2, ucn, presodd          ;       39605000
byte pointer                       sbuff, ebuff                         39610000
                                                               ;        39615000
                                                                        39620000
option privileged, uncallable                                 ;         39625000
                                                                        39630000
begin                                                                   39635000
                                                                        39640000
COMMENT                                                                 39645000
                                                                        39650000
     PURPOSE:  This routine's reason for living is to convert or        39655000
translate the function codes and parameters recieved by the logical     39660000
driver to escape sequences that will be understood by the 2608B.        39665000
                                                                        39670000
     INPUT PARAMETERS:  The input parameters are:                       39675000
FUNC - The function code sent to the logical driver.                    39680000
P1   - The device dependant parameter for the function code.            39685000
P2   - Another device dependant qualifier on the function code.         39690000
PRESODD = 1 - Make start sequence odd.                                  39695000
        = 0 - Make start sequence even.                                 39700000
POINR - A two word interger array used as change of state variables     39705000
        in the translation sequence.                                    39710000
UCN   - Number of bytes in the user array.  Used to determine if the    39715000
        trailing sequence should be odd.                                39720000
XPARENCY - True implies transparency mode requested.                    39725000
                                                                        39730000
     OUTPUT PARAMETERS:  The return parameters are:                     39735000
SCNT  - Number of bytes in the start escape sequence.                   39740000
SBUFF - Buffer containing the start escape sequence.                    39745000
ECNT  - Number of bytes in the end escape sequence.                     39750000
EBUFF - Buffer containing the end escape sequence.                      39755000
ERR   - Error indicator with the following values:                      39760000
      = 0 - No error found.                                             39765000
      = 1 - Illegal function code specified.                            39770000
                                                                        39775000
                                                                        39780000
CHANGE HISTORY                                                          39785000
                                                                        39790000
                                                                        39795000
;                                                                       39800000
                                                                        39805000
define                                                                  39810000
       scnt            =irtnv(1).(0:8)#                                 39815000
      ,ecnt            =irtnv(1).(8:8)#                                 39820000
      ,err             =irtnv(0)#                                       39825000
      ,first'time'flag =poinr.(8:1)#                                    39830000
      ,precnt          =poinr.(7:1)#                           <<07425>>39835000
      ,p2save          =poinr.(9:7)#                                    39840000
      ,print'on'perf   = logical( P2.(14:1) ) #                <<04472>>39845000
      ,pre'space       = logical( P2.(15:1) ) #                <<04475>>39850000
      ,old'tof         =poinr.(0:1)#                                    39855000
      ,new'tof         =poinr.(1:1)#                                    39860000
      ,p'start         =%33,"&p "#                                      39865000
      ,l'start         =%33,"&l "#                                      39870000
      ,slew'start      =%15,%33,"&a +"#                                 39875000
      ,slew'tail       ="R"#                                            39880000
      ,xpar'tail       ="X"#                                            39885000
      ,space           =" "#                                            39890000
      ,cr              =%15#                                            39895000
;                                                                       39900000
integer                                                                 39905000
        i                                                               39910000
       ,j                                                               39915000
       ,k                                                               39920000
       ,l                                                               39925000
;                                                                       39930000
                                                                        39935000
byte array                                                              39940000
        bl(*)=l                                                         39945000
;                                                                       39950000
                                                                        39955000
double                                                                  39960000
       rtnvalue                                                         39965000
;                                                                       39970000
integer array                                                           39975000
              irtnv(*)=rtnvalue;                                        39980000
                                                                        39985000
byte pointer                                                            39990000
     single                                                             39995000
;                                                                       40000000
                                                                        40005000
integer                                                                 40010000
       single'cnt                                                       40015000
;                                                                       40020000
                                                                        40025000
logical array                                                           40030000
              language'code(0:15)=pb:=                                  40035000
    "0U"                                                                40040000
   ,"0V"                                                                40045000
   ,"1R"                                                                40050000
   ,"1K"                                                                40055000
   ,"0L"                                                                40060000
   ,"1L"                                                                40065000
   ,"0M"                                                                40070000
   ,"0P"                                                                40075000
   ,"0F"                                                                40080000
   ,"0G"                                                                40085000
   ,"0S"                                                                40090000
   ,"0D"                                                                40095000
   ,"1S"                                                                40100000
   ,"1E"                                                                40105000
   ,"0K"                                                                40110000
   ,"0E"                                                                40115000
;                                                                       40120000
                                                                        40125000
@single := @ebuff(40);                                                  40130000
ERR:=illegal'func'cd;                                                   40135000
irtnv:=0;                                                               40140000
cpr'xlate:=rtnvalue;                                                    40145000
IF FUNC<0  OR FUNC > 144 THEN RETURN;                                   40150000
I:=0;J:=0;new'tof:=0;                                                   40155000
if first'time'flag = 0 then                                             40160000
  begin                                                                 40165000
                                                               <<04472>>40170000
  first'time'flag:=1;                                                   40175000
  old'tof:=0;                                                           40180000
  end;                                                                  40185000
CASE FUNC OF                                                            40190000
  BEGIN  << of case statement >>                                        40195000
  RETURN;                                                               40200000
                                                                        40205000
                                                                        40210000
  BEGIN   <<FUNC = 1 - WRITE DATA>>                                     40215000
COMMENT     Check for a change of state between this call and the       40220000
   last and make sure that the escape sequence to handle it is          40225000
retruned.                                                               40230000
;                                                                       40235000
                                                                        40240000
                                                                        40245000
<< If change mode from old pre'space to current post  >>       <<07425>>40250000
<< space and precnt eq to 1 then insert a blank line >>        <<07425>>40255000
<< otherwise no change.                               >>       <<07425>>40260000
    IF P2.(15:1)=0 AND POINR.(15:1)=1 and logical(precnt) THEN <<07425>>40265000
      BEGIN                                                             40270000
      << Changing pre to post spacing and has data in buffer>> <<07425>>40275000
      MOVE SBUFF(I):=(l'start,"3V");                           <<04472>>40280000
      << Insert a blank line >>                                <<07425>>40285000
      I:=I+6;                                                           40290000
      << Adjust the buffer pointer >>                          <<07425>>40295000
      END;                                                              40300000
                                                               <<07425>>40305000
    precnt := (ucn <> 0) LOR ( (p1 = %320) LAND                <<07425>>40310000
                              Logical (precnt));               <<07425>>40315000
<<   If byte counter not eq to 0 or ( no space/carriage  >>    <<07425>>40320000
<<   control and precnt is true, then set precnt to true >>    <<07425>>40325000
<<   otherwise precnt eq to false.                    >>       <<07425>>40330000
                                                                        40335000
    P2save:=P2;                                                <<04472>>40340000
                                                                        40345000
    IF print'on'perf THEN                                      <<04472>>40350000
      BEGIN                                                             40355000
      MOVE single:=(slew'start,"1",slew'tail);                          40360000
      single'cnt:=8;                                                    40365000
      end else                                                          40370000
      begin                                                             40375000
      move single:=(l'start,"3V");                                      40380000
      single'cnt:=6;                                                    40385000
      END;                                                              40390000
                                                                        40395000
                                                                        40400000
<< P1 selects what will happen during the write and P2 tells us         40405000
   where to put it (front or rear). >>                                  40410000
                                                                        40415000
                                                                        40420000
    IF P1=%53 OR P1=%200 THEN                                           40425000
      BEGIN                                                             40430000
      IF P2.(15:1)=1 THEN                                               40435000
        BEGIN                                                           40440000
        MOVE SBUFF(I):=(cr);                                            40445000
        I:=I+1;                                                         40450000
        END ELSE                                                        40455000
        BEGIN                                                           40460000
        MOVE EBUFF(J):=(cr);                                            40465000
        J:=J+1;                                                         40470000
        END;                                                            40475000
      END ELSE                                                          40480000
                                                                        40485000
                                                                        40490000
    IF P1>%200 AND P1<%300 THEN                                         40495000
      BEGIN                                                             40500000
      IF P2.(15:1)=1 THEN                                               40505000
        BEGIN                                                           40510000
        MOVE SBUFF(I):=(slew'start);                                    40515000
        I:=I+6;                                                         40520000
        K:=B08'ASCII(P1-%200,10,SBUFF(I));                              40525000
        I:=I+K;                                                         40530000
        IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END;              40535000
        SBUFF(I):=slew'tail;I:=I+1; <<APPEND STRING TERMINATOR>>        40540000
        END ELSE                                                        40545000
        BEGIN                                                           40550000
        MOVE EBUFF(J):=(slew'start);                                    40555000
        J:=J+6;                                                         40560000
        K:=B08'ASCII(P1-%200,10,EBUFF(J));                              40565000
        J:=J+K;                                                         40570000
        IF K.(15:1)=0 THEN BEGIN EBUFF(J):=%40;J:=J+1;END;              40575000
        EBUFF(J):=slew'tail;J:=J+1; <<APPEND STRING TERMINATOR>>        40580000
        END;                                                            40585000
      END ELSE                                                          40590000
                                                                        40595000
                                                                        40600000
    IF P1 > %277 AND P1 < %320 THEN                            <<04474>>40605000
      BEGIN                                                             40610000
      IF P2.(15:1)=1 THEN                                               40615000
                                                                        40620000
        BEGIN                                                           40625000
        MOVE SBUFF(I):=(l'start);                                       40630000
        I:=I+4;                                                         40635000
        K:=B08'ASCII(P1-%277,10,SBUFF(I));                              40640000
        I:=I+K;                                                         40645000
        IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END;              40650000
        SBUFF(I):="V";I:=I+1; <<APPEND STRING TERMINATOR>>              40655000
                                                                        40660000
        END ELSE                                                        40665000
        BEGIN                                                           40670000
        MOVE EBUFF(J):=(l'start);                                       40675000
        J:=J+4;                                                         40680000
        K:=B08'ASCII(P1-%277,10,EBUFF(J));                              40685000
        J:=J+K;                                                         40690000
        IF K.(15:1)=0 THEN BEGIN EBUFF(J):=%40;J:=J+1;END;              40695000
        EBUFF(J):="V";J:=J+1; <<APPEND STRING TERMINATOR>>              40700000
        END;                                                            40705000
      END ELSE                                                          40710000
                                                                        40715000
                                                                        40720000
    if p1=%55 then                                             <<04472>>40725000
      if xparency and not print'on'perf then                   <<04472>>40730000
        if p2.(15:1) = 1 then                                  <<04472>>40735000
          begin                                                <<04472>>40740000
          move sbuff(i):=(l'start,"5V");                       <<04472>>40745000
          i:=i+6;                                              <<04472>>40750000
          end                                                  <<04472>>40755000
        else                                                   <<04472>>40760000
          begin                                                <<04472>>40765000
          move ebuff(j):=(l'start,"5V");                       <<04472>>40770000
          j:=j+6;                                              <<04472>>40775000
          end                                                  <<04472>>40780000
      else                                                     <<04472>>40785000
        if not print'on'perf then                              <<04472>>40790000
          if p2.(15:1) = 1 then                                <<04472>>40795000
            begin                                              <<04472>>40800000
            move sbuff(i):=                                    <<04472>>40805000
                 (l'start,"3V",l'start,"3V",l'start,"3V");     <<04472>>40810000
            i:=i+18;                                           <<04472>>40815000
            end                                                <<04472>>40820000
          else                                                 <<04472>>40825000
            begin                                              <<04472>>40830000
            move ebuff(j):=                                    <<04472>>40835000
                 (l'start,"3V",l'start,"3V",l'start,"3V");     <<04472>>40840000
            j:=j+18;                                           <<04472>>40845000
            end                                                <<04472>>40850000
        else                                                   <<04472>>40855000
          if p2.(15:1) = 1 then                                <<04472>>40860000
            begin                                              <<04472>>40865000
            move sbuff(i):=(slew'start,"3",slew'tail);         <<04472>>40870000
            i:=i+8;                                            <<04472>>40875000
            end                                                <<04472>>40880000
          else                                                 <<04472>>40885000
            begin                                              <<04472>>40890000
            move ebuff(j):=(slew'start,"3",slew'tail);         <<04472>>40895000
            j:=j+8;                                            <<04472>>40900000
            end                                                <<04472>>40905000
    else                                                       <<04472>>40910000
                                                               <<04472>>40915000
    if p1=%60 then                                             <<04472>>40920000
      if xparency and not print'on'perf then                   <<04472>>40925000
        if p2.(15:1) = 1 then                                  <<04472>>40930000
          begin                                                <<04472>>40935000
          move sbuff(i):=(l'start,"4V");                       <<04472>>40940000
          i:=i+6;                                              <<04472>>40945000
          end                                                  <<04472>>40950000
        else                                                   <<04472>>40955000
          begin                                                <<04472>>40960000
          move ebuff(j):=(l'start,"4V");                       <<04472>>40965000
          j:=j+6;                                              <<04472>>40970000
          end                                                  <<04472>>40975000
      else                                                     <<04472>>40980000
        if not print'on'perf then                              <<04472>>40985000
          if p2.(15:1) = 1 then                                <<04472>>40990000
            begin                                              <<04472>>40995000
            move sbuff(i):=                                    <<04472>>41000000
                 (l'start,"3V",l'start,"3V");                  <<04472>>41005000
            i:=i+12;                                           <<04472>>41010000
            end                                                <<04472>>41015000
          else                                                 <<04472>>41020000
            begin                                              <<04472>>41025000
            move ebuff(j):=                                    <<04472>>41030000
                 (l'start,"3V",l'start,"3V");                  <<04472>>41035000
            j:=j+12;                                           <<04472>>41040000
            end                                                <<04472>>41045000
        else                                                   <<04472>>41050000
          if p2.(15:1) = 1 then                                <<04472>>41055000
            begin                                              <<04472>>41060000
            move sbuff(i):=(slew'start,"2",slew'tail);         <<04472>>41065000
            i:=i+8;                                            <<04472>>41070000
            end                                                <<04472>>41075000
          else                                                 <<04472>>41080000
            begin                                              <<04472>>41085000
            move ebuff(j):=(slew'start,"2",slew'tail);         <<04472>>41090000
            j:=j+8;                                            <<04472>>41095000
            end                                                <<04472>>41100000
    else                                                       <<04472>>41105000
                                                                        41110000
                                                                        41115000
    IF P1 = %61 THEN                                           <<04472>>41120000
      BEGIN                                                             41125000
      new'tof := integer( (not pre'space) lor (ucn = 0) );     <<04475>>41130000
      IF old'tof =0 or ucn>0 then                                       41135000
        begin                                                           41140000
        IF P2.(15:1)=1 THEN                                             41145000
          BEGIN                                                         41150000
          MOVE SBUFF(I):=(l'start,"1V");                       <<04422>>41155000
          I:=I+6;                                                       41160000
          END ELSE                                                      41165000
          BEGIN                                                         41170000
          MOVE EBUFF(J):=(l'start,"1V");                       <<04422>>41175000
          J:=J+6;                                                       41180000
          END;                                                          41185000
        end;                                                            41190000
      END ELSE                                                          41195000
                                                                        41200000
                                                                        41205000
    IF P1=%62 THEN                                                      41210000
      BEGIN                                                             41215000
      IF P2.(15:1)=1 THEN                                               41220000
        BEGIN                                                           41225000
        MOVE SBUFF(I):=(l'start,"011V");                                41230000
        I:=I+8;                                                         41235000
        END ELSE                                                        41240000
        BEGIN                                                           41245000
        MOVE EBUFF(J):=(l'start,"011V");                                41250000
        J:=J+8;                                                         41255000
        END;                                                            41260000
      END ELSE                                                          41265000
                                                                        41270000
                                                                        41275000
    IF P1=%63 THEN                                                      41280000
      BEGIN                                                             41285000
      IF P2.(15:1)=1 THEN                                               41290000
        BEGIN                                                           41295000
        MOVE SBUFF(I):=(l'start,"0V");                         <<04422>>41300000
        I:=I+6;                                                         41305000
        END ELSE                                                        41310000
        BEGIN                                                           41315000
        MOVE EBUFF(J):=(l'start,"0V");                         <<04422>>41320000
        J:=J+6;                                                         41325000
        END;                                                            41330000
    END ELSE                                                            41335000
                                                                        41340000
                                                                        41345000
    IF P1=%320 THEN                                                     41350000
      BEGIN                                                             41355000
      END ELSE                                                          41360000
    BEGIN                                                               41365000
                                                                        41370000
                                                                        41375000
    IF P2.(15:1)=1 THEN                                                 41380000
      BEGIN                                                             41385000
      MOVE SBUFF(I):=single,(single'cnt);                               41390000
      I:=I+single'cnt;                                                  41395000
      END ELSE                                                          41400000
      BEGIN                                                             41405000
      MOVE EBUFF(J):=single,(single'cnt);                               41410000
      J:=J+single'cnt;                                                  41415000
      END;                                                              41420000
    END;                                                                41425000
                                                                        41430000
                                                                        41435000
                                                                        41440000
    If xparency then                                                    41445000
     begin                                                              41450000
      move sbuff(i):=(p'start);                                         41455000
      i:=i+4;                                                           41460000
      k:=b08'ascii(ucn,10,sbuff(i));                                    41465000
      i:=i+k;                                                           41470000
      if k.(15:1)=0 then                                                41475000
       begin                                                            41480000
        sbuff(i):=space;                                                41485000
        i:=i+1;                                                         41490000
       end;                                                             41495000
      sbuff(i):=xpar'tail;                                              41500000
      i:=i+1;                                                           41505000
     end;                                                               41510000
    old'tof:=new'tof;                                                   41515000
  END;   <<END OF FUNC=1>>                                              41520000
                                                                        41525000
                                                                        41530000
                                                                        41535000
  BEGIN  << FUNCTION CODE 2 - FOPEN >>                                  41540000
  MOVE SBUFF(I):=(l'start,"0V");                                        41545000
  I:=I+6;                                                               41550000
  old'tof := 1;                                                <<04472>>41555000
  END;                                                                  41560000
                                                                        41565000
                                                                        41570000
  BEGIN  << FUNCTION CODE 3 - FCLOSE >>                                 41575000
  MOVE SBUFF(I):=(l'start,"0V");                                        41580000
  I:=I+6;                                                               41585000
  old'tof := 1;                                                <<04472>>41590000
  END;                                                                  41595000
                                                                        41600000
                                                                        41605000
  BEGIN  << FUNCTION CODE 4 - DEVICE CLOSE >>                           41610000
  MOVE SBUFF(I):=(l'start,"0V");                                        41615000
  I:=I+6;                                                               41620000
  END;  << of function = 4 >>                                           41625000
                                                                        41630000
                                                                        41635000
  RETURN;  <<FUNCTION CODE 5 >>                                         41640000
                                                                        41645000
  RETURN;  <<FUNCTION CODE 6 >>                                         41650000
                                                                        41655000
                                                                        41660000
  RETURN;  <<FUNCTION CODE 7 >>                                         41665000
                                                                        41670000
                                                                        41675000
  RETURN;  <<FUNCTION CODE 8 >>                                         41680000
                                                                        41685000
                                                                        41690000
  RETURN;  <<FUNCTION CODE 9 >>                                         41695000
                                                                        41700000
                                                                        41705000
  RETURN;  <<FUNCTION CODE 10 >>                                        41710000
                                                                        41715000
                                                                        41720000
  RETURN;  <<FUNCTION CODE 11 >>                                        41725000
                                                                        41730000
                                                                        41735000
  RETURN;  <<FUNCTION CODE 12 >>                                        41740000
                                                                        41745000
                                                                        41750000
  RETURN;  <<FUNCTION CODE 13 >>                                        41755000
                                                                        41760000
                                                                        41765000
  RETURN;  <<FUNCTION CODE 14 >>                                        41770000
                                                                        41775000
                                                                        41780000
  RETURN;  <<FUNCTION CODE 15 >>                                        41785000
                                                                        41790000
                                                                        41795000
  RETURN;  <<FUNCTION CODE 16 >>                                        41800000
                                                                        41805000
                                                                        41810000
  RETURN;  <<FUNCTION CODE 17 >>                                        41815000
                                                                        41820000
                                                                        41825000
  RETURN;  <<FUNCTION CODE 18 >>                                        41830000
                                                                        41835000
                                                                        41840000
  RETURN;  <<FUNCTION CODE 19 >>                                        41845000
                                                                        41850000
                                                                        41855000
  RETURN;  <<FUNCTION CODE 20 >>                                        41860000
                                                                        41865000
                                                                        41870000
  RETURN;  <<FUNCTION CODE 21 >>                                        41875000
                                                                        41880000
                                                                        41885000
  RETURN;  <<FUNCTION CODE 22 >>                                        41890000
                                                                        41895000
                                                                        41900000
  RETURN;  <<FUNCTION CODE 23 >>                                        41905000
                                                                        41910000
                                                                        41915000
  RETURN;  <<FUNCTION CODE 24 >>                                        41920000
                                                                        41925000
                                                                        41930000
  RETURN;  <<FUNCTION CODE 25 >>                                        41935000
                                                                        41940000
                                                                        41945000
  RETURN;  <<FUNCTION CODE 26 >>                                        41950000
                                                                        41955000
                                                                        41960000
  RETURN;  <<FUNCTION CODE 27 >>                                        41965000
                                                                        41970000
                                                                        41975000
  RETURN;  <<FUNCTION CODE 28 >>                                        41980000
                                                                        41985000
                                                                        41990000
  RETURN;  <<FUNCTION CODE 29 >>                                        41995000
                                                                        42000000
                                                                        42005000
  RETURN;  <<FUNCTION CODE 30 >>                                        42010000
                                                                        42015000
                                                                        42020000
  RETURN;  <<FUNCTION CODE 31 >>                                        42025000
                                                                        42030000
                                                                        42035000
  RETURN;  <<FUNCTION CODE 32 >>                                        42040000
                                                                        42045000
                                                                        42050000
  RETURN;  <<FUNCTION CODE 33 >>                                        42055000
                                                                        42060000
                                                                        42065000
  RETURN;  <<FUNCTION CODE 34 >>                                        42070000
                                                                        42075000
                                                                        42080000
  RETURN;  <<FUNCTION CODE 35 >>                                        42085000
                                                                        42090000
                                                                        42095000
  RETURN;  <<FUNCTION CODE 36 >>                                        42100000
                                                                        42105000
                                                                        42110000
  RETURN;  <<FUNCTION CODE 37 >>                                        42115000
                                                                        42120000
                                                                        42125000
  RETURN;  <<FUNCTION CODE 38 >>                                        42130000
                                                                        42135000
                                                                        42140000
  RETURN;  <<FUNCTION CODE 39 >>                                        42145000
                                                                        42150000
                                                                        42155000
  RETURN;  <<FUNCTION CODE 40 >>                                        42160000
                                                                        42165000
                                                                        42170000
  RETURN;  <<FUNCTION CODE 41 >>                                        42175000
                                                                        42180000
                                                                        42185000
  RETURN;  <<FUNCTION CODE 42 >>                                        42190000
                                                                        42195000
                                                                        42200000
  RETURN;  <<FUNCTION CODE 43 >>                                        42205000
                                                                        42210000
                                                                        42215000
  RETURN;  <<FUNCTION CODE 44 >>                                        42220000
                                                                        42225000
                                                                        42230000
  RETURN;  <<FUNCTION CODE 45 >>                                        42235000
                                                                        42240000
                                                                        42245000
  RETURN;  <<FUNCTION CODE 46 >>                                        42250000
                                                                        42255000
                                                                        42260000
  RETURN;  <<FUNCTION CODE 47 >>                                        42265000
                                                                        42270000
                                                                        42275000
  RETURN;  <<FUNCTION CODE 48 >>                                        42280000
                                                                        42285000
                                                                        42290000
  RETURN;  <<FUNCTION CODE 49 >>                                        42295000
                                                                        42300000
                                                                        42305000
  RETURN;  <<FUNCTION CODE 50 >>                                        42310000
                                                                        42315000
                                                                        42320000
  RETURN;  <<FUNCTION CODE 51 >>                                        42325000
                                                                        42330000
                                                                        42335000
  RETURN;  <<FUNCTION CODE 52 >>                                        42340000
                                                                        42345000
                                                                        42350000
  RETURN;  <<FUNCTION CODE 53 >>                                        42355000
                                                                        42360000
                                                                        42365000
  RETURN;  <<FUNCTION CODE 54 >>                                        42370000
                                                                        42375000
                                                                        42380000
  RETURN;  <<FUNCTION CODE 55 >>                                        42385000
                                                                        42390000
                                                                        42395000
  RETURN;  <<FUNCTION CODE 56 >>                                        42400000
                                                                        42405000
                                                                        42410000
  RETURN;  <<FUNCTION CODE 57 >>                                        42415000
                                                                        42420000
                                                                        42425000
  RETURN;  <<function code 58 >>                                        42430000
                                                                        42435000
                                                                        42440000
  RETURN;  <<FUNCTION CODE 59 >>                                        42445000
                                                                        42450000
                                                                        42455000
  RETURN;  <<FUNCTION CODE 60 >>                                        42460000
                                                                        42465000
                                                                        42470000
  RETURN;  <<FUNCTION CODE 61 >>                                        42475000
                                                                        42480000
                                                                        42485000
  RETURN;  <<FUNCTION CODE 62 >>                                        42490000
                                                                        42495000
                                                                        42500000
  RETURN;  <<FUNCTION CODE 63 >>                                        42505000
                                                                        42510000
                                                                        42515000
  BEGIN    <<FUNCTION CODE 64 >>                                        42520000
  MOVE SBUFF(I):=(l'start);                                             42525000
  I:=I+4;                                                               42530000
  K:=B08'ASCII(P1,10,SBUFF(I));                                         42535000
  I:=I+K;                                                               42540000
  IF K.(15:1)=0 THEN BEGIN SBUFF(I):=space;I:=I+1;END; <<PAD TO EVEN>>  42545000
  SBUFF(I):="d";I:=I+1; << ADD SUFFIX >>                                42550000
  IF UCN=0 THEN                                                         42555000
    BEGIN                                                               42560000
    MOVE SBUFF(I):=("0P");                                     <<04434>>42565000
    I:=I+2;                                                    <<04434>>42570000
    END ELSE                                                            42575000
    BEGIN                                                               42580000
    K:=B08'ASCII(UCN,10,SBUFF(I));                                      42585000
    I:=I+K;                                                             42590000
    IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END;                  42595000
    SBUFF(I):="W";I:=I+1;                                               42600000
    END;                                                                42605000
  END;                                                                  42610000
                                                                        42615000
                                                                        42620000
  BEGIN    <<FUNCTION CODE 65 >>                                        42625000
  P1 := P1 + 1;  << Increment because margin base is zero >>   <<04422>>42630000
  MOVE SBUFF(I):=(%33,"&a ");                                           42635000
  I:=I+4;                                                               42640000
  K:=B08'ASCII(P1,10,SBUFF(I));                                         42645000
  I:=I+K;                                                               42650000
  IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END; <<PAD TO EVEN>>    42655000
  SBUFF(I):="L";I:=I+1;  << ADD SEQUENCE TERMINATOR >>                  42660000
  END;                                                                  42665000
                                                                        42670000
                                                                        42675000
  RETURN;  <<FUNCTION CODE 66 >>                                        42680000
                                                                        42685000
                                                                        42690000
  RETURN;  <<FUNCTION CODE 67 >>                                        42695000
                                                                        42700000
                                                                        42705000
  RETURN;  <<FUNCTION CODE 68 >>                                        42710000
                                                                        42715000
                                                                        42720000
  RETURN;  <<FUNCTION CODE 69 >>                                        42725000
                                                                        42730000
                                                                        42735000
  RETURN;  <<FUNCTION CODE 70 >>                                        42740000
                                                                        42745000
                                                                        42750000
  BEGIN    <<FUNCTION CODE 71 >>                                        42755000
  MOVE SBUFF(I):=(%33,"Z");                                             42760000
  I:=I+2;                                                               42765000
  END;                                                                  42770000
                                                                        42775000
                                                                        42780000
  RETURN;  <<FUNCTION CODE 72 >>                                        42785000
                                                                        42790000
                                                                        42795000
  RETURN;  <<FUNCTION CODE 73 >>                                        42800000
                                                                        42805000
                                                                        42810000
  RETURN;  <<FUNCTION CODE 74 >>                                        42815000
                                                                        42820000
                                                                        42825000
  RETURN;  <<FUNCTION CODE 75 >>                                        42830000
                                                                        42835000
                                                                        42840000
  RETURN;  <<FUNCTION CODE 76 >>                                        42845000
                                                                        42850000
                                                                        42855000
  RETURN;  <<FUNCTION CODE 77 >>                                        42860000
                                                                        42865000
                                                                        42870000
  RETURN;  <<FUNCTION CODE 78 >>                                        42875000
                                                                        42880000
                                                                        42885000
  RETURN;  <<FUNCTION CODE 79 >>                                        42890000
                                                                        42895000
                                                                        42900000
  RETURN;  <<FUNCTION CODE 80 >>                                        42905000
                                                                        42910000
                                                                        42915000
  RETURN;  <<FUNCTION CODE 81 >>                                        42920000
                                                                        42925000
                                                                        42930000
  RETURN;  <<FUNCTION CODE 82 >>                                        42935000
                                                                        42940000
                                                                        42945000
  RETURN;  <<FUNCTION CODE 83 >>                                        42950000
                                                                        42955000
                                                                        42960000
  RETURN;  <<FUNCTION CODE 84 >>                                        42965000
                                                                        42970000
                                                                        42975000
  RETURN;  <<FUNCTION CODE 85 >>                                        42980000
                                                                        42985000
                                                                        42990000
  RETURN;  <<FUNCTION CODE 86 >>                                        42995000
                                                                        43000000
                                                                        43005000
  RETURN;  <<FUNCTION CODE 87 >>                                        43010000
                                                                        43015000
                                                                        43020000
  RETURN;  <<FUNCTION CODE 88 >>                                        43025000
                                                                        43030000
                                                                        43035000
  RETURN;  <<FUNCTION CODE 89 >>                                        43040000
                                                                        43045000
                                                                        43050000
  RETURN;  <<FUNCTION CODE 90 >>                                        43055000
                                                                        43060000
                                                                        43065000
  RETURN;  <<FUNCTION CODE 91 >>                                        43070000
                                                                        43075000
                                                                        43080000
  RETURN;  <<FUNCTION CODE 92 >>                                        43085000
                                                                        43090000
                                                                        43095000
  RETURN;  <<FUNCTION CODE 93 >>                                        43100000
                                                                        43105000
                                                                        43110000
  RETURN;  <<FUNCTION CODE 94 >>                                        43115000
                                                                        43120000
                                                                        43125000
  RETURN;  <<FUNCTION CODE 95 >>                                        43130000
                                                                        43135000
                                                                        43140000
  RETURN;  <<FUNCTION CODE 96 >>                                        43145000
                                                                        43150000
                                                                        43155000
  RETURN;  <<FUNCTION CODE 97 >>                                        43160000
                                                                        43165000
                                                                        43170000
  RETURN;  <<FUNCTION CODE 98 >>                                        43175000
                                                                        43180000
                                                                        43185000
  RETURN;  <<FUNCTION CODE 99 >>                                        43190000
                                                                        43195000
                                                                        43200000
  RETURN;  <<FUNCTION CODE 100 >>                                       43205000
                                                                        43210000
                                                                        43215000
  RETURN;  <<FUNCTION CODE 101 >>                                       43220000
                                                                        43225000
                                                                        43230000
  RETURN;  <<FUNCTION CODE 102 >>                                       43235000
                                                                        43240000
                                                                        43245000
  RETURN;  <<FUNCTION CODE 103 >>                                       43250000
                                                                        43255000
                                                                        43260000
  RETURN;  <<FUNCTION CODE 104 >>                                       43265000
                                                                        43270000
                                                                        43275000
  RETURN;  <<FUNCTION CODE 105 >>                                       43280000
                                                                        43285000
                                                                        43290000
  RETURN;  <<FUNCTION CODE 106 >>                                       43295000
                                                                        43300000
                                                                        43305000
  RETURN;  <<FUNCTION CODE 107 >>                                       43310000
                                                                        43315000
                                                                        43320000
  RETURN;  <<FUNCTION CODE 108 >>                                       43325000
                                                                        43330000
                                                                        43335000
  RETURN;  <<FUNCTION CODE 109 >>                                       43340000
                                                                        43345000
                                                                        43350000
  RETURN;  <<FUNCTION CODE 110 >>                                       43355000
                                                                        43360000
                                                                        43365000
  RETURN;  <<FUNCTION CODE 111 >>                                       43370000
                                                                        43375000
                                                                        43380000
  RETURN;  <<FUNCTION CODE 112 >>                                       43385000
                                                                        43390000
                                                                        43395000
  RETURN;  <<FUNCTION CODE 113 >>                                       43400000
                                                                        43405000
                                                                        43410000
  RETURN;  <<FUNCTION CODE 114 >>                                       43415000
                                                                        43420000
                                                                        43425000
  RETURN;  <<FUNCTION CODE 115 >>                                       43430000
                                                                        43435000
                                                                        43440000
  RETURN;  <<FUNCTION CODE 116 >>                                       43445000
                                                                        43450000
                                                                        43455000
  RETURN;  <<FUNCTION CODE 117 >>                                       43460000
                                                                        43465000
                                                                        43470000
  RETURN;  <<FUNCTION CODE 118 >>                                       43475000
                                                                        43480000
                                                                        43485000
  RETURN;  <<FUNCTION CODE 119 >>                                       43490000
                                                                        43495000
                                                                        43500000
  RETURN;  <<FUNCTION CODE 120 >>                                       43505000
                                                                        43510000
                                                                        43515000
  RETURN;  <<FUNCTION CODE 121 >>                                       43520000
                                                                        43525000
                                                                        43530000
  RETURN;  <<FUNCTION CODE 122 >>                                       43535000
                                                                        43540000
                                                                        43545000
  RETURN;  <<FUNCTION CODE 123 >>                                       43550000
                                                                        43555000
                                                                        43560000
  RETURN;  <<FUNCTION CODE 124 >>                                       43565000
                                                                        43570000
                                                                        43575000
  RETURN;  <<FUNCTION CODE 125 >>                                       43580000
                                                                        43585000
                                                                        43590000
  RETURN;  <<FUNCTION CODE 126 >>                                       43595000
                                                                        43600000
                                                                        43605000
  RETURN;  <<FUNCTION CODE 127 >>                                       43610000
                                                                        43615000
                                                                        43620000
  BEGIN    <<FUNCTION CODE 128 >>                                       43625000
  MOVE SBUFF(I):=(%33,"(");                                             43630000
  I:=I+2;                                                               43635000
  k:=p1.(12:4);l:=language'code(k);                                     43640000
  sbuff(i):=bl(0);i:=i+1;                                               43645000
  sbuff(i):=bl(1);i:=i+1;                                               43650000
  MOVE SBUFF(I):=(%33,")");I:=I+2;                                      43655000
  k:=p2.(12:4);l:=language'code(k);                                     43660000
  sbuff(i):=bl(0);i:=i+1;                                               43665000
  sbuff(i):=bl(1);i:=i+1;                                               43670000
  END;                                                                  43675000
                                                                        43680000
                                                                        43685000
  RETURN;  <<FUNCTION CODE 129 >>                                       43690000
                                                                        43695000
                                                                        43700000
  RETURN;  <<FUNCTION CODE 130 >>                                       43705000
                                                                        43710000
                                                                        43715000
  RETURN;  <<FUNCTION CODE 131 >>                                       43720000
                                                                        43725000
                                                                        43730000
  RETURN;  <<FUNCTION CODE 132 >>                                       43735000
                                                                        43740000
                                                                        43745000
  RETURN;  <<FUNCTION CODE 133 >>                                       43750000
                                                                        43755000
                                                                        43760000
  RETURN;  <<FUNCTION CODE 134 >>                                       43765000
                                                                        43770000
                                                                        43775000
  RETURN;  <<FUNCTION CODE 135 >>                                       43780000
                                                                        43785000
                                                                        43790000
  RETURN;  <<FUNCTION CODE 136 >>                                       43795000
                                                                        43800000
                                                                        43805000
  RETURN;  <<FUNCTION CODE 137 >>                                       43810000
                                                                        43815000
                                                                        43820000
  RETURN;  <<FUNCTION CODE 138 >>                                       43825000
                                                                        43830000
                                                                        43835000
  RETURN;  <<FUNCTION CODE 139 >>                                       43840000
                                                                        43845000
                                                                        43850000
  RETURN;  <<FUNCTION CODE 140 >>                                       43855000
                                                                        43860000
                                                                        43865000
  BEGIN    <<FUNCTION CODE 141 >>                                       43870000
  MOVE SBUFF(I):=(%33,"E");                                             43875000
  I:=I+2;                                                               43880000
  END;                                                                  43885000
                                                                        43890000
                                                                        43895000
  BEGIN    <<FUNCTION CODE 142 >>                              <<04472>>43900000
    P2save := 0;                                               <<04472>>43905000
    precnt := false;                                           <<07425>>43910000
    old'tof := 1;                                              <<04472>>43915000
  END;                                                         <<04472>>43920000
                                                                        43925000
                                                                        43930000
  BEGIN    <<FUNCTION CODE 143 >>                                       43935000
  MOVE SBUFF(I):=(%33,"E");                                             43940000
  I:=I+2;                                                               43945000
  END;                                                                  43950000
                                                                        43955000
                                                                        43960000
  RETURN;  <<FUNCTION CODE 144 >>                                       43965000
END;  << of case statement >>                                           43970000
                                                                        43975000
                                                                        43980000
<< Make certain that the ones requested odd are odd. >>                 43985000
IF PRESODD=1 AND I>0 THEN                                               43990000
  BEGIN                                                                 43995000
  K:=0;                                                                 44000000
  WHILE SBUFF(K)<>%40 DO K:=K+1;                                        44005000
  IF K<I THEN                                                           44010000
    BEGIN                                                               44015000
    MOVE SBUFF(K):=SBUFF(K+1),(I-K);                                    44020000
    I:=I-1;                                                             44025000
    END;                                                                44030000
  END;                                                                  44035000
                                                                        44040000
                                                                        44045000
IF UCN.(15:1)=1 AND J>0 THEN                                            44050000
  BEGIN                                                                 44055000
  K:=0;                                                                 44060000
  WHILE EBUFF(K)<>%40 DO K:=K+1;                                        44065000
  IF K<J THEN                                                           44070000
    BEGIN                                                               44075000
    MOVE EBUFF(K):=EBUFF(K+1),(J-K);                                    44080000
    J:=J-1;                                                             44085000
    END;                                                                44090000
  END;                                                                  44095000
                                                                        44100000
                                                                        44105000
<< make sure the goods are sent back >>                                 44110000
  SCNT:=I;                                                              44115000
   ECNT:=J;                                                             44120000
  ERR:=no'errors;                                                       44125000
                                                                        44130000
cpr'xlate:=rtnvalue;                                                    44135000
end; <<cpr'xlate>>                                                      44140000
                                                                        44145000
  << CIPER level 7 >>                                                   44150000
$PAGE "PROCEDURE:  B08'CLEAN'COMP'STATUS"                               44155000
procedure b08'clean'comp'status( cb'info );                             44160000
                                                                        44165000
  value                          cb'info  ;                             44170000
                                                                        44175000
  integer pointer                cb'info  ;                             44180000
                                                                        44185000
  option privileged, uncallable           ;                             44190000
                                                                        44195000
                                                                        44200000
COMMENT                                                                 44205000
                                                                        44210000
  PURPOSE:                                                              44215000
                                                                        44220000
    This procedure will zero out the cbix area known as the             44225000
    composite status area.  This region will contain a 'logical         44230000
    or' of all device status reports that are received during           44235000
    a single call to the logical driver.  The contents of this          44240000
    area are returned if a calling program requests buffered            44245000
    composite status.                                                   44250000
                                                                        44255000
    The area is zeroed out at the start of every call to the            44260000
    logical driver, or after the contents are returned to the           44265000
    calling program.                                                    44270000
                                                                        44275000
                                                                        44280000
  INPUT PARAMETERS:                                                     44285000
                                                                        44290000
    CB'INFO, which points to the control block information              44295000
      (CBI) area of the logical driver.  This area contains             44300000
      the pointer to the composite status area, as well as a            44305000
      flag which is set true to indicate that some composite            44310000
      status is available.                                              44315000
                                                                        44320000
                                                                        44325000
  OUTPUT PARAMETERS:                                                    44330000
                                                                        44335000
    None.                                                               44340000
                                                                        44345000
                                                                        44350000
  SIDE-EFFECTS:                                                         44355000
                                                                        44360000
    None.                                                               44365000
                                                                        44370000
                                                                        44375000
  SPECIAL CONSIDERATIONS:                                               44380000
                                                                        44385000
    When called, DB must be pointing to the CIPER data segment.         44390000
                                                                        44395000
                                                                        44400000
  CHANGE HISTORY:                                                       44405000
                                                                        44410000
    As issued.                                                          44415000
                                                                        44420000
;                                                                       44425000
$PAGE "PROCEDURE:  B08'CLEAN'COMP'STATUS -- LOCAL DECLARATIONS"         44430000
begin                                                                   44435000
                                                                        44440000
  integer pointer                                                       44445000
                                                                        44450000
    comp'status                                                         44455000
      << points to the composite status area of the CBIX >>             44460000
                                                                        44465000
  ;                                                                     44470000
$PAGE "PROCEDURE:  B08'CLEAN'COMP'STATUS -- PROCEDURE BODY"             44475000
  << Initialize the pointer to the composite status area >>             44480000
                                                                        44485000
  @comp'status := cb'info(composite'status'base)                        44490000
                + cb'info(cds'area'base);                               44495000
                                                                        44500000
                                                                        44505000
  << Turn off the flag that indicates some composite status >>          44510000
  << is available.                                          >>          44515000
                                                                        44520000
  cb'info(comp'stat'available) := false;                                44525000
                                                                        44530000
                                                                        44535000
  << Zero out the area. >>                                              44540000
                                                                        44545000
  x := comp'status'length - 1;                                          44550000
                                                                        44555000
  do                                                                    44560000
    begin                                                               44565000
      comp'status(x) := 0;                                              44570000
    end                                                                 44575000
  until (x := x - 1) < 0;                                               44580000
                                                                        44585000
                                                                        44590000
  << All done >>                                                        44595000
                                                                        44600000
end;  << of procedure b08'clean'comp'status >>                          44605000
$PAGE "PROCEDURE: B08'WORST'STATUS"                            <<07425>>44610000
integer procedure b08'worst'status( status'one, status'two );  <<07425>>44615000
                                                               <<07425>>44620000
  value                             status'one, status'two  ;  <<07425>>44625000
                                                               <<07425>>44630000
  integer                           status'one, status'two  ;  <<07425>>44635000
                                                               <<07425>>44640000
COMMENT                                                        <<07425>>44645000
                                                               <<07425>>44650000
   PURPOSE:                                                    <<07425>>44655000
     The procedure will determine which one of the two statuses<<07425>>44660000
     is worst and it will return that value.                   <<07425>>44665000
                                                               <<07425>>44670000
   INPUT PARAMETERS:                                           <<07425>>44675000
                                                               <<07425>>44680000
     STATUS'ONE and STATUS'TWO are two statuses that can be    <<07425>>44685000
         from any procedures.                                  <<07425>>44690000
                                                               <<07425>>44695000
   OUTPUT PARAMETERS:                                          <<07425>>44700000
                                                               <<07425>>44705000
     B08'WORST'STATUS, will contain the worst of the two       <<07425>>44710000
       statuses.                                               <<07425>>44715000
                                                               <<07425>>44720000
   CHANGE HISTORY:                                             <<07425>>44725000
                                                               <<07425>>44730000
     08/30/83  Satish Janardan Created the procedure.          <<07425>>44735000
                                                               <<07425>>44740000
;                                                              <<07425>>44745000
                                                               <<07425>>44750000
begin                                                          <<07425>>44755000
                                                               <<07425>>44760000
  << DECLARATION OF LOCAL VARIABLES >>                         <<07425>>44765000
  equate                                                       <<07425>>44770000
    max'no'of'errors = 6;                                      <<07425>>44775000
                                                               <<07425>>44780000
  integer array                                                <<07425>>44785000
                                                               <<07425>>44790000
    status'ranks(1:max'no'of'errors+1) = PB := %1, %4, %243,   <<07425>>44795000
                          %304, %213, %314, %0;                <<07425>>44800000
      <<The array contains all the return status codes.  The>> <<07425>>44805000
      <<return codes are ordered from least fatal to fatal. >> <<07425>>44810000
                                                               <<07425>>44815000
  integer                                                      <<07425>>44820000
                                                               <<07425>>44825000
    status'one'rank,                                           <<07425>>44830000
    status'two'rank,                                           <<07425>>44835000
      << Contains the rank for each of the statuses. >>        <<07425>>44840000
    i;                                                         <<07425>>44845000
                                                               <<07425>>44850000
  << Scan the status'rank array until the ranks for the>>      <<07425>>44855000
  << statuses is found.  If the status is not found,   >>      <<07425>>44860000
  << assign the largest rank number.                   >>      <<07425>>44865000
                                                               <<07425>>44870000
  i := 1;                                                      <<07425>>44875000
  while i <= max'no'of'errors and                              <<07425>>44880000
        status'ranks(i) <> status'one do                       <<07425>>44885000
    i := i + 1;                                                <<07425>>44890000
  status'one'rank := i;                                        <<07425>>44895000
                                                               <<07425>>44900000
  i := 1;                                                      <<07425>>44905000
  while i <= max'no'of'errors and                              <<07425>>44910000
        status'ranks(i) <> status'two do                       <<07425>>44915000
    i := i + 1;                                                <<07425>>44920000
  status'two'rank := i;                                        <<07425>>44925000
                                                               <<07425>>44930000
                                                               <<07425>>44935000
                                                               <<07425>>44940000
  << Pass back the worst status (the status with the   >>      <<07425>>44945000
  << larger rank number).                              >>      <<07425>>44950000
                                                               <<07425>>44955000
  if status'one'rank > status'two'rank then                    <<07425>>44960000
     b08'worst'status := status'one                            <<07425>>44965000
  else                                                         <<07425>>44970000
     b08'worst'status := status'two;                           <<07425>>44975000
                                                               <<07425>>44980000
end;                                                           <<07425>>44985000
                                                               <<07425>>44990000
                                                                        44995000
$PAGE "PROCEDURE:  B08'GET'BUFFER"                                      45000000
logical procedure b08'get'buffer(cb'info, override'option);             45005000
                                                                        45010000
  value                          cb'info, override'option ;             45015000
                                                                        45020000
  integer pointer                cb'info                  ;             45025000
                                                                        45030000
  integer                                 override'option ;             45035000
                                                                        45040000
  option privileged, uncallable                           ;             45045000
                                                                        45050000
                                                                        45055000
COMMENT                                                                 45060000
                                                                        45065000
  PURPOSE:                                                              45070000
                                                                        45075000
    This procedure will delink and allocate a record buffer             45080000
    area, if one is available from the free-list.  If no area           45085000
    is available, zero is returned, otherwise the DB-relative           45090000
    address of the area is returned.                                    45095000
                                                                        45100000
                                                                        45105000
  INPUT PARAMETERS:                                                     45110000
                                                                        45115000
    CB'INFO, which points to the control block information              45120000
      area of level 7.  The free-list pointer is maintained in          45125000
      this global area.                                                 45130000
                                                                        45135000
    OVERRIDE'OPTION, which describes what the caller wants              45140000
      done if there are no buffer areas in the freelist.  If            45145000
      a value of zero is specified, a nil pointer will be re-           45150000
      turned.  A value of one will cause the dedicated output           45155000
      buffer to be returned.  A value of two will cause the             45160000
      dedicated input buffer to be used.                                45165000
                                                                        45170000
                                                                        45175000
  OUTPUT PARAMETERS:                                                    45180000
                                                                        45185000
    B08'GET'BUFFER, which is the function return, will be nil           45190000
      if no buffer was available, otherwise it will return the          45195000
      DB-relative address of the buffer.                                45200000
                                                                        45205000
                                                                        45210000
  SIDE-EFFECTS:                                                         45215000
                                                                        45220000
    None.                                                               45225000
                                                                        45230000
                                                                        45235000
  SPECIAL CONSIDERATIONS:                                               45240000
                                                                        45245000
    When called, DB must be set to the base of the CIPER data           45250000
    segment.                                                            45255000
                                                                        45260000
                                                                        45265000
  CHANGE HISTORY:                                                       45270000
                                                                        45275000
    As issued.                                                          45280000
                                                                        45285000
                                                                        45290000
;                                                                       45295000
$PAGE "PROCEDURE:  B08'GET'BUFFER -- LOCAL VARIABLES"                   45300000
begin                                                                   45305000
                                                                        45310000
  integer pointer                                                       45315000
                                                                        45320000
    new'buffer                                                          45325000
      << points to buffer acquired from free-list >>                    45330000
                                                                        45335000
  ;                                                                     45340000
$PAGE "PROCEDURE:  B08'GET'BUFFER -- PROCEDURE BODY"                    45345000
                                                                        45350000
  if cb'info(free'buff'list) = nil then                                 45355000
    begin                                                               45360000
      << No buffers are available from the freelist.  The >>            45365000
      << override option will tell us what to do.         >>            45370000
                                                                        45375000
      case override'option of                                           45380000
        begin                                                           45385000
                                                                        45390000
          << No override, return nil >>                                 45395000
          begin                                                         45400000
            @new'buffer := nil;                                         45405000
          end;                                                          45410000
                                                                        45415000
          << Use the dedicated output buffer >>                         45420000
          begin                                                         45425000
            @new'buffer := cb'info(o'r'base)                            45430000
                         + cb'info(cds'area'base);                      45435000
                                                                        45440000
            if logical( new'buffer(active) ) then                       45445000
              begin                                                     45450000
                new'buffer(active) := free;                             45455000
                cb'info(out'recs'overwritten) :=                        45460000
                    cb'info(out'recs'overwritten) + 1;                  45465000
              end;                                                      45470000
          end;                                                          45475000
                                                                        45480000
          << Use the dedicated input buffer >>                          45485000
          begin                                                         45490000
            @new'buffer := cb'info(i'r'base)                            45495000
                         + cb'info(cds'area'base);                      45500000
                                                                        45505000
            if logical( new'buffer(active) ) then                       45510000
              begin                                                     45515000
                new'buffer(active) := free;                             45520000
                cb'info(in'recs'overwritten) :=                         45525000
                    cb'info(in'recs'overwritten) + 1;                   45530000
              end;                                                      45535000
          end;                                                          45540000
                                                                        45545000
        end;  << of case override'option >>                             45550000
                                                                        45555000
    end                                                                 45560000
  else                                                                  45565000
    begin                                                               45570000
      << There is a buffer available.  Delink it and init >>            45575000
      << ialize.                                           >>           45580000
                                                                        45585000
      @new'buffer := cb'info(free'buff'list)                            45590000
                   + cb'info(cds'area'base);                            45595000
                                                                        45600000
      cb'info(free'buff'list) := new'buffer(forward'link);              45605000
                                                                        45610000
      new'buffer(forward'link) := nil;                                  45615000
      new'buffer(allocated) := in'use;                                  45620000
    end;                                                                45625000
                                                                        45630000
  b08'get'buffer := @new'buffer;                                        45635000
                                                                        45640000
end;  << of procedure b08'get'buffer >>                                 45645000
                                                                        45650000
$PAGE "PROCEDURE:  B08'RELEASE'BUFFER"                                  45655000
logical procedure b08'release'buffer(cb'info, old'buffer);              45660000
                                                                        45665000
  value                              cb'info, old'buffer ;              45670000
                                                                        45675000
  integer pointer                    cb'info, old'buffer ;              45680000
                                                                        45685000
  option privileged, uncallable                          ;              45690000
                                                                        45695000
                                                                        45700000
COMMENT                                                                 45705000
                                                                        45710000
  PURPOSE:                                                              45715000
                                                                        45720000
    This procedure will deallocate (relink into free-list)              45725000
    the record buffer area pointed to by old'buffer.  When              45730000
    placed in the free-list, the pointer is converted from              45735000
    DB-relative to cds area relative.                                   45740000
                                                                        45745000
                                                                        45750000
  INPUT PARAMETERS:                                                     45755000
                                                                        45760000
    CB'INFO, a pointer to the control block information area,           45765000
      where the free-list head is maintained.                           45770000
                                                                        45775000
    OLD'BUFFER, the DB-relative pointer to the buffer area to           45780000
      be placed in the free-list.                                       45785000
                                                                        45790000
                                                                        45795000
  OUTPUT PARAMETERS:                                                    45800000
                                                                        45805000
    None.                                                               45810000
                                                                        45815000
                                                                        45820000
  SIDE-EFFECTS:                                                         45825000
                                                                        45830000
    None.                                                               45835000
                                                                        45840000
                                                                        45845000
  SPECIAL CONSIDERATIONS:                                               45850000
                                                                        45855000
    When called, DB must be pointing to the CIPER data segment.         45860000
                                                                        45865000
                                                                        45870000
  CHANGE HISTORY:                                                       45875000
                                                                        45880000
    As issued.                                                          45885000
                                                                        45890000
                                                                        45895000
;                                                                       45900000
$PAGE "PROCEDURE:  B08'RELEASE'BUFFER -- PROCEDURE BODY"                45905000
begin                                                                   45910000
                                                                        45915000
  << Determine if the buffer is to actually be released, or >>          45920000
  << just marked free.                                      >>          45925000
                                                                        45930000
  if @old'buffer = (cb'info(o'r'base) + cb'info(cds'area'base))         45935000
  or @old'buffer = (cb'info(i'r'base) + cb'info(cds'area'base))         45940000
  then                                                                  45945000
    begin                                                               45950000
      old'buffer(active) := free;                                       45955000
      old'buffer(ready) := false;                                       45960000
    end                                                                 45965000
  else                                                                  45970000
    begin                                                               45975000
      << First, tie in the rest of the list. >>                         45980000
                                                                        45985000
      old'buffer(forward'link) := cb'info(free'buff'list);              45990000
                                                                        45995000
      << Next, mark buffer as 'not allocated' >>                        46000000
                                                                        46005000
      x := ready + 1;                                                   46010000
      while dxbz do old'buffer(x) := free;                              46015000
                                                                        46020000
      << Add buffer into head of free-list. >>                          46025000
                                                                        46030000
      cb'info(free'buff'list) := @old'buffer                            46035000
                               - cb'info(cds'area'base);                46040000
    end;                                                                46045000
                                                                        46050000
  << All done!! >>                                                      46055000
                                                                        46060000
end;  << of procedure b08'release'buffer >>                             46065000
                                                                        46070000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS"                                   46075000
integer procedure b08'device'status(cb'info, i'r'control);              46080000
                                                                        46085000
  value                             cb'info, i'r'control ;              46090000
                                                                        46095000
  integer pointer                   cb'info, i'r'control ;              46100000
                                                                        46105000
  option privileged, uncallable                          ;              46110000
                                                                        46115000
                                                                        46120000
                                                                        46125000
COMMENT                                                                 46130000
                                                                        46135000
  PURPOSE:                                                              46140000
                                                                        46145000
    This procedure will evaluate the device status report re-           46150000
    turned by the 2608B printer.  If necessary, messages will           46155000
    be sent to the system console to alert the operator of              46160000
    the state of the device.  The latest copy of the status             46165000
    report will be stored in the cbix for comparison against            46170000
    a future status report.                                             46175000
                                                                        46180000
                                                                        46185000
  INPUT PARAMETERS:                                                     46190000
                                                                        46195000
    CB'INFO, which is a pointer to the control block informa-           46200000
      tion area of this particular device and level.                    46205000
                                                                        46210000
    I'R'CONTROL, which is a pointer to the input record buffer          46215000
      which contains the device status report to be processed.          46220000
                                                                        46225000
                                                                        46230000
  OUTPUT PARAMETERS:                                                    46235000
                                                                        46240000
    B08'DEVICE'STATUS, which is an integer function return.             46245000
      This will contain the completion status of the call.  A           46250000
      value of one is returned if no errors were detected.              46255000
      Other values will be defined as required.                         46260000
                                                                        46265000
                                                                        46270000
  SIDE-EFFECTS:                                                         46275000
                                                                        46280000
    This procedure may cause messages to be sent to the system          46285000
    console.  In addition, its function return value may in-            46290000
    dicate exceptional conditions, such as device powerfail,            46295000
    which will have to be reported back to the calling process          46300000
    for potential error recovery.                                       46305000
                                                                        46310000
                                                                        46315000
  SPECIAL CONSIDERATIONS:                                               46320000
                                                                        46325000
    When called, DB must be set to the base of the CIPER data           46330000
    segment.                                                            46335000
                                                                        46340000
                                                                        46345000
  CHANGE HISTORY:                                                       46350000
                                                                        46355000
    8/31/83  Satish Janardan                                   <<07425>>46360000
                                                               <<07425>>46365000
    In the event of eerors, execute a device clear only if not <<07425>>46370000
    already in progress.                                       <<07425>>46375000
                                                                        46380000
                                                                        46385000
;                                                                       46390000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS -- LOCAL VARIABLES"                46395000
begin                                                                   46400000
                                                                        46405000
  << DECLARATION OF LOCAL VARIABLES >>                                  46410000
                                                                        46415000
                                                                        46420000
  integer                                                               46425000
                                                                        46430000
    return'status                 = b08'device'status                   46435000
      << Function return status >>                                      46440000
                                                               <<04446>>46445000
   ,dc'results                                                 <<04446>>46450000
      << Status return from device clear, if one is done >>    <<04446>>46455000
                                                                        46460000
  ;                                                                     46465000
                                                                        46470000
                                                                        46475000
  logical pointer                                                       46480000
                                                                        46485000
    old'status                                                          46490000
      << points to base of old (previous) status report con- >>         46495000
      << tained in the cbix.                                 >>         46500000
                                                                        46505000
   ,new'status                                                          46510000
      << points to base of new status report which, when     >>         46515000
      << this procedure is called, will still be located in  >>         46520000
      << an input record buffer area.                        >>         46525000
                                                                        46530000
  ;                                                                     46535000
                                                                        46540000
                                                                        46545000
  byte pointer                                                          46550000
                                                                        46555000
    move'from                                                           46560000
      << points to first byte of device status while it is   >>         46565000
      << still in an input record buffer area.  Used to move >>         46570000
      << the status report into the permanent status area.   >>         46575000
                                                                        46580000
   ,move'to                                                             46585000
      << Points to the region of the permanent status area   >>         46590000
      << where the status report is to be moved, when taken  >>         46595000
      << out of the input record buffer area.                >>         46600000
                                                                        46605000
  ;                                                                     46610000
                                                                        46615000
                                                                        46620000
  logical                                                               46625000
                                                                        46630000
    delta'status                                                        46635000
      << contains bit map of status bits that have changed >>           46640000
                                                                        46645000
   ,do'device'clear                                                     46650000
      << Set true to indicate that a device clear should be >>          46655000
      << performed before exiting because of certain device >>          46660000
      << failures (such as power fail, protocol errors, etc >>          46665000
                                                                        46670000
                                                                        46675000
  ;                                                                     46680000
                                                                        46685000
  logical array                                                         46690000
                                                                        46695000
    message'map(0:31)             = pb :=                               46700000
                                                                        46705000
      << ps'on base starts here >>                                      46710000
                                                                        46715000
      on'line'msg                                                       46720000
     ,paper'out'msg                                                     46725000
     ,paper'jam'msg                                                     46730000
     ,platen'open'msg                                                   46735000
     ,ribbon'error'msg                                                  46740000
     ,0                                                                 46745000
     ,0                                                                 46750000
     ,0                                                                 46755000
                                                                        46760000
      << ps'off base starts here >>                                     46765000
                                                                        46770000
     ,off'line'msg                                                      46775000
     ,0                                                                 46780000
     ,0                                                                 46785000
     ,0                                                                 46790000
     ,0                                                                 46795000
     ,0                                                                 46800000
     ,0                                                                 46805000
     ,0                                                                 46810000
                                                                        46815000
      << cpe'base starts here >>                                        46820000
                                                                        46825000
     ,msg'illegal'header'length                                         46830000
     ,msg'record'sequence'error                                         46835000
     ,msg'illegal'creator'of'record                                     46840000
     ,msg'undef'record'opcode                                           46845000
     ,msg'undef'data'type                                               46850000
     ,msg'bad'esb'format'number                                         46855000
     ,0                                                                 46860000
     ,msg'bad'block'label'length                                        46865000
     ,msg'transport'error                                               46870000
     ,msg'data'overrun                                                  46875000
     ,0                                                                 46880000
     ,0                                                                 46885000
     ,0                                                                 46890000
     ,0                                                                 46895000
     ,0                                                                 46900000
     ,0                                                                 46905000
                                                                        46910000
  ;                                                                     46915000
                                                                        46920000
                                                                        46925000
  equate                                                                46930000
                                                                        46935000
    pson'base                     = 0                                   46940000
      << message'map base for peripheral status bits set >>             46945000
                                                                        46950000
   ,psoff'base                    = 8                                   46955000
      << message'map base for peripheral status bits clear >>           46960000
                                                                        46965000
   ,cpe'base                      = 16                                  46970000
      << message'map base for ciper protocol error bits set >>          46975000
                                                                        46980000
  ;                                                                     46985000
                                                                        46990000
                                                                        46995000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS -- SUBROUTINE: EVALUATE"           47000000
subroutine evaluate(range, message'base, bit'set);                      47005000
                                                                        47010000
  value             range, message'base, bit'set ;                      47015000
                                                                        47020000
  integer           range, message'base, bit'set ;                      47025000
                                                                        47030000
                                                                        47035000
COMMENT                                                                 47040000
                                                                        47045000
;                                                                       47050000
                                                                        47055000
begin                                                                   47060000
                                                                        47065000
  if range = 8 then bit'set := bit'set & lsl(8);                        47070000
                                                                        47075000
  do                                                                    47080000
    begin                                                               47085000
      if bit'set < 0 and message'map(message'base) <> 0 then            47090000
        begin                                                           47095000
          cpr'genmsg(ciper'set,                                         47100000
                     message'map(message'base),                         47105000
                     %10000,cb'info(logical'device),,,,,0);             47110000
        end;                                                            47115000
      bit'set := bit'set & lsl(1);                                      47120000
      message'base := message'base + 1;                                 47125000
      range := range - 1;                                               47130000
    end                                                                 47135000
  until range = 0;                                                      47140000
                                                                        47145000
end;  << of subroutine evaluate >>                                      47150000
                                                                        47155000
                                                                        47160000
                                                                        47165000
                                                                        47170000
                                                                        47175000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS -- PROCEDURE BODY"                 47180000
  << Initialize the flag that indicates whether or not a >>             47185000
  << device clear needs to be performed.                 >>             47190000
                                                                        47195000
  do'device'clear := false;                                             47200000
                                                                        47205000
                                                                        47210000
  << Set error return to initial value >>                               47215000
                                                                        47220000
  b08'device'status := successful;                                      47225000
                                                                        47230000
                                                                        47235000
  << Set up pointers for the permanent status area >>                   47240000
                                                                        47245000
  @old'status := cb'info(dev'status'base)                               47250000
               + cb'info(cds'area'base);                                47255000
  @new'status := @old'status + (device'status'length to'word);          47260000
                                                                        47265000
                                                                        47270000
  << Move the new status from the input record buffer, so it >>         47275000
  << will be aligned on a word boundary.  Then set the re-   >>         47280000
  << cord buffer area free.                                  >>         47285000
                                                                        47290000
  @move'from := i'r'control(current'position)                           47295000
              + @i'r'control to'byte;                                   47300000
  @move'to := @new'status to'byte;                                      47305000
  move move'to := move'from,(device'status'length);                     47310000
  i'r'control(active) := integer(free);                                 47315000
                                                                        47320000
                                                                        47325000
  << Now, start moving the new information in bit by bit, so >>         47330000
  << any change can be detected.  Under certain circumstan-  >>         47335000
  << ses, a message will have to sent to the console.        >>         47340000
                                                                        47345000
  << Evaluate the self test failure bit.  If it is >>                   47350000
  << set, send the failure message, incorporating the fail- >>          47355000
  << ure code as part of the message.                       >>          47360000
                                                                        47365000
  old'status(self'test'failed) := new'status(self'test'failed);         47370000
  old'status(self'test'code) := new'status(self'test'code);             47375000
                                                                        47380000
  if old'status(self'test'failed) then                                  47385000
    begin                                                               47390000
                                                                        47395000
      cpr'genmsg( ciper'set                                             47400000
                 ,self'test'msg                                         47405000
                 ,%11000  << parm mask >>                               47410000
                 ,cb'info(logical'device)                               47415000
                 ,old'status(self'test'code)                            47420000
                 ,  << parm 3 >>                                        47425000
                 ,  << parm 4 >>                                        47430000
                 ,  << parm 5 >>                                        47435000
                 ,0  << destination:  console >>  );                    47440000
                                                                        47445000
      return'status := error'so'read'status;                            47450000
                                                                        47455000
    end;                                                                47460000
                                                                        47465000
                                                                        47470000
                                                                        47475000
  << Now check the CIPER protocol error byte. >>                        47480000
                                                                        47485000
  old'status(ciper'protocol'errors) :=                                  47490000
      new'status(ciper'protocol'errors);                                47495000
                                                                        47500000
  if old'status(ciper'protocol'errors) is'not'zero then                 47505000
    begin                                                               47510000
      << A protocol error has occurred, so evaluate bit >>              47515000
      << by bit.                                        >>              47520000
                                                                        47525000
      evaluate(16,cpe'base,old'status(ciper'protocol'errors));          47530000
                                                                        47535000
      do'device'clear := true;                                          47540000
                                                                        47545000
      b08'device'status := error'so'read'status;                        47550000
                                                                        47555000
    end;  << of new ciper protocol errors >>                            47560000
                                                                        47565000
                                                                        47570000
  << Next, check the powerfail information >>                           47575000
                                                                        47580000
  old'status(peripheral'errors) :=                                      47585000
      new'status(peripheral'errors);                                    47590000
                                                                        47595000
  if old'status(power'fail) then                                        47600000
    begin                                                               47605000
                                                                        47610000
        << send the power fail message to the console  >>               47615000
                                                                        47620000
      cpr'genmsg( ciper'set                                             47625000
                 ,power'up'msg                                          47630000
                 ,%10000  << parm mask >>                               47635000
                 ,cb'info(logical'device)                               47640000
                 ,  << parm 2 >>                                        47645000
                 ,  << parm 3 >>                                        47650000
                 ,  << parm 4 >>                                        47655000
                 ,  << parm 5 >>                                        47660000
                 ,0  << destination:  console >> );                     47665000
                                                                        47670000
      do'device'clear := true;                                          47675000
                                                                        47680000
      << set the error return to reflect a power fail >>                47685000
                                                                        47690000
      b08'device'status := pf'error;                                    47695000
    end                                                                 47700000
  else                                                                  47705000
    begin                                                               47710000
                                                                        47715000
      if old'status(possible'data'loss) then                            47720000
        begin                                                           47725000
                                                                        47730000
          cpr'genmsg( ciper'set                                         47735000
                     ,msg'data'lost                                     47740000
                     ,%10000  << parm mask >>                           47745000
                     ,cb'info(logical'device)                           47750000
                     ,  << parm 2 >>                                    47755000
                     ,  << parm 3 >>                                    47760000
                     ,  << parm 4 >>                                    47765000
                     ,  << parm 5 >>                                    47770000
                     ,0  << destination:  console >>  );                47775000
                                                                        47780000
          return'status := error'so'read'status;                        47785000
                                                                        47790000
        end;                                                            47795000
    end;                                                                47800000
                                                                        47805000
                                                                        47810000
  << Next, evaluate the peripheral status byte, which con-   >>         47815000
  << tains on-line/off-line, paper out, paper jam, platen    >>         47820000
  << open, ribbon error, and mechanical error information.   >>         47825000
                                                                        47830000
  if old'status(peripheral'status) <>                                   47835000
      new'status(peripheral'status) then                                47840000
    begin                                                               47845000
                                                                        47850000
      delta'status := old'status(peripheral'status) xor                 47855000
          new'status(peripheral'status);                                47860000
                                                                        47865000
      evaluate(8,pson'base,(delta'status land                           47870000
          new'status(peripheral'status)));                              47875000
                                                                        47880000
      evaluate(8,psoff'base,(delta'status land                          47885000
          old'status(peripheral'status)));                              47890000
                                                                        47895000
      old'status(peripheral'status) :=                                  47900000
          new'status(peripheral'status);                                47905000
                                                                        47910000
      if return'status = successful then                                47915000
        begin                                                           47920000
          << Nothing serious has been detected yet, so look >>          47925000
          << for minor errors that the user/spooler might   >>          47930000
          << want to know about.                            >>          47935000
                                                                        47940000
          if old'status(paper'jam)                                      47945000
          or old'status(platen'open)                                    47950000
          or old'status(ribbon'error) then                              47955000
            begin                                                       47960000
                                                                        47965000
              return'status := error'so'read'status;                    47970000
                                                                        47975000
            end;                                                        47980000
        end;                                                            47985000
                                                                        47990000
                                                                        47995000
    end;  << of changes in peripheral status byte >>                    48000000
                                                                        48005000
                                                                        48010000
  << Now merge the new status received into the composite >>            48015000
  << status area.  This area only reflects status reports >>            48020000
  << received during this call to the logical driver.     >>            48025000
                                                                        48030000
  @new'status := cb'info(composite'status'area)                         48035000
               + cb'info(cds'area'base);                                48040000
                                                                        48045000
  x := comp'status'length - 1;                                          48050000
                                                                        48055000
  do                                                                    48060000
    begin                                                               48065000
      new'status(x) := new'status(x) lor old'status(x);                 48070000
    end                                                                 48075000
  until (x := x - 1) < 0;                                               48080000
                                                                        48085000
  cb'info(comp'stat'available) := true;                                 48090000
                                                                        48095000
                                                                        48100000
  << Set status management bits to reflect the fact that >>             48105000
  << some new status is available.                       >>             48110000
                                                                        48115000
  cb'info(status'received).dev'stat'bit := set'bit;                     48120000
  cb'info(status'reported).dev'stat'bit := clear'bit;                   48125000
                                                                        48130000
                                                                        48135000
  << If the flag to perform a device clear has been set, >>             48140000
  << now is the time to execute the command.             >>             48145000
<< Do not call the procedure b08'device'clear if >>            <<07425>>48150000
<< this procedure was called from within         >>            <<07425>>48155000
<< procedure b08'device'clear                    >>            <<07425>>48160000
                                                                        48165000
if do'device'clear and                                         <<07425>>48170000
   not logical( cb'info(dev'clr'in'progress) ) then            <<07425>>48175000
    begin                                                               48180000
                                                                        48185000
      dc'results := b08'device'clear( cb'info, 1 );            <<04446>>48190000
      return'status := b08'worst'status(return'status,         <<07425>>48195000
                                        dc'results);           <<07425>>48200000
                                                                        48205000
    end;                                                                48210000
                                                                        48215000
                                                                        48220000
end;  << of b08'device'status >>                                        48225000
                                                                        48230000
$PAGE "PROCEDURE:  B08'JOB'REPORT"                                      48235000
integer procedure B08'job'report(cb'info, i'r'control);                 48240000
                                                                        48245000
  value                          cb'info, i'r'control ;                 48250000
                                                                        48255000
  integer pointer                cb'info, i'r'control ;                 48260000
                                                                        48265000
  option privileged, uncallable                       ;                 48270000
                                                                        48275000
                                                                        48280000
COMMENT                                                                 48285000
                                                                        48290000
  PURPOSE:                                                              48295000
                                                                        48300000
    This procedure will evaluate the contents of a device's             48305000
    JOB REPORT, which is returned when the device completes             48310000
    the processing associated with a particular job.  The               48315000
    format of the report is device dependent, but in the case           48320000
    of the 2608B printer, the following information is re-              48325000
    turned:                                                             48330000
                                                                        48335000
      word 0 - number of physical sheets printed during job             48340000
                                                                        48345000
                                                                        48350000
  INPUT PARAMETERS:                                                     48355000
                                                                        48360000
    CB'INFO, which is a pointer to the control block informa-           48365000
      tion area of the logical driver for this device.                  48370000
                                                                        48375000
    I'R'CONTROL, which is a pointer to the input record buffer          48380000
      that contains the job report to be processed.                     48385000
                                                                        48390000
                                                                        48395000
  OUTPUT PARAMETERS:                                                    48400000
                                                                        48405000
    B08'JOB'REPORT, which is the function completion code.  A           48410000
      value of one is returned if no errors occurred during the         48415000
      processing of the job report.  Other values will be de-           48420000
      fined as required.                                                48425000
                                                                        48430000
                                                                        48435000
  SIDE-EFFECTS:                                                         48440000
                                                                        48445000
    The job report area will be updated with the information            48450000
    returned by the device.  The input record buffer will be            48455000
    released to the free list when finished.                            48460000
                                                                        48465000
                                                                        48470000
  SPECIAL CONSIDERATIONS:                                               48475000
                                                                        48480000
    When called, DB must be set to the base of the CIPER data           48485000
    segment.  The record pointed to by i'r'control must be              48490000
    marked as active, or the procedure will return an error.            48495000
                                                                        48500000
                                                                        48505000
  CHANGE HISTORY:                                                       48510000
                                                                        48515000
    As issued.                                                          48520000
                                                                        48525000
;                                                                       48530000
                                                                        48535000
$PAGE "PROCEDURE:  B08'JOB'REPORT -- LOCAL DECLARATIONS"                48540000
begin                                                                   48545000
                                                                        48550000
  << Declaration of local variables and constants >>                    48555000
                                                                        48560000
  byte pointer                                                          48565000
                                                                        48570000
    input'position                                                      48575000
      << points to current position in input buffer >>                  48580000
                                                                        48585000
   ,report'base                                                         48590000
      << points to base of job report area of CDS >>                    48595000
                                                                        48600000
  ;                                                                     48605000
                                                                        48610000
                                                                        48615000
$PAGE "PROCEDURE:  B08'JOB'REPORT -- PROCEDURE BODY"                    48620000
  << First, set up the pointer to the job report area and >>            48625000
  << the input data.                                      >>            48630000
                                                                        48635000
  @report'base := ( cb'info(job'report'base)                            48640000
                    + cb'info(cds'area'base) ) to'byte;                 48645000
                                                                        48650000
  @input'position := i'r'control(current'position)                      48655000
                   + @i'r'control to'byte;                              48660000
                                                                        48665000
  << Now move the information into the job report area. >>              48670000
                                                                        48675000
  move report'base := input'position,(job'report'length);               48680000
                                                                        48685000
  << Set the input record free. >>                                      48690000
                                                                        48695000
  i'r'control(active) := free;                                          48700000
                                                                        48705000
  << All done! >>                                                       48710000
                                                                        48715000
  b08'job'report := no'errors;                                          48720000
                                                                        48725000
end;  << of b08'job'report >>                                           48730000
                                                                        48735000
$PAGE "PROCEDURE B08'RCV'RDY"                                           48740000
integer procedure B08'rcv'rdy(cb'info, i'r'control);                    48745000
                                                                        48750000
  value                       cb'info, i'r'control ;                    48755000
                                                                        48760000
  integer pointer             cb'info, i'r'control ;                    48765000
                                                                        48770000
  option privileged, uncallable                    ;                    48775000
                                                                        48780000
                                                                        48785000
COMMENT                                                                 48790000
                                                                        48795000
  PURPOSE:                                                              48800000
                                                                        48805000
    This procedure evaluates RECEIVE READY responces from the           48810000
    peripheral, and adds the reported buffer count to the               48815000
    count of available peripheral buffers maintained in the             48820000
    control block information area.                                     48825000
                                                                        48830000
                                                                        48835000
  INPUT PARAMETERS:                                                     48840000
                                                                        48845000
    CB'INFO, the pointer to the control block information area,         48850000
      where the receive ready count is maintained.                      48855000
                                                                        48860000
    I'R'CONTROL, which points to the input record buffer area           48865000
      that contains the RECEIVE READY report to evaluate.               48870000
                                                                        48875000
                                                                        48880000
  OUTPUT PARAMETERS:                                                    48885000
                                                                        48890000
    B08'RCV'RDY, which will take on the completion status of            48895000
      the call.  A value of one is returned if no errors were           48900000
      encountered.  Other values will be defined as required.           48905000
                                                                        48910000
                                                                        48915000
  SIDE-EFFECTS:                                                         48920000
                                                                        48925000
    The receive ready count will be incremented by the amount           48930000
    contained in the RECEIVE READY report.                              48935000
                                                                        48940000
                                                                        48945000
  SPECIAL CONSIDERATIONS:                                               48950000
                                                                        48955000
    When called, DB must be set to the base of the CIPER data           48960000
    segment.                                                            48965000
                                                                        48970000
                                                                        48975000
  CHANGE HISTORY:                                                       48980000
                                                                        48985000
    As issued.                                                          48990000
                                                                        48995000
;                                                                       49000000
$PAGE "PROCEDURE:  B08'RCV'RDY -- LOCAL DECLARATIONS"                   49005000
                                                                        49010000
begin                                                                   49015000
                                                                        49020000
  integer pointer                                                       49025000
                                                                        49030000
    input'record                                                        49035000
      << points to base of data area of input record >>                 49040000
                                                                        49045000
  ;                                                                     49050000
                                                                        49055000
$PAGE "PROCEDURE:  B08'RCV'RDY -- PROCEDURE BODY"                       49060000
  << Set up pointer to data area of record >>                           49065000
                                                                        49070000
  @input'record := i'r'control(start) + @i'r'control;                   49075000
                                                                        49080000
  << Update receive ready count >>                                      49085000
                                                                        49090000
  cb'info(receive'ready'count) := cb'info(receive'ready'count)          49095000
      + input'record(parm'byte'1);                                      49100000
                                                                        49105000
  << Release the input record >>                                        49110000
                                                                        49115000
  i'r'control(active) := free;                                          49120000
                                                                        49125000
  << All done!! >>                                                      49130000
                                                                        49135000
  b08'rcv'rdy := no'errors;                                             49140000
                                                                        49145000
end;  << of procedure b08'rcv'rdy >>                                    49150000
                                                                        49155000
$PAGE "PROCEDURE:  B08'ENV'STATUS"                                      49160000
integer procedure b08'env'status(cb'info, i'r'control);                 49165000
                                                                        49170000
  value                          cb'info, i'r'control ;                 49175000
                                                                        49180000
  integer pointer                cb'info, i'r'control ;                 49185000
                                                                        49190000
  option privileged, uncallable                       ;                 49195000
                                                                        49200000
                                                                        49205000
COMMENT                                                                 49210000
                                                                        49215000
  PURPOSE:                                                              49220000
                                                                        49225000
    This procedure will move the environmental status block             49230000
    from an input buffer to the appropriate status tank within          49235000
    the CIPER data segment.                                             49240000
                                                                        49245000
                                                                        49250000
  INPUT PARAMETERS:                                                     49255000
                                                                        49260000
    CB'INFO, a pointer to the control block information area            49265000
      of Level 7 for this ldev.  The pointer to the status              49270000
      tank is contained in the cbix.                                    49275000
                                                                        49280000
    I'R'CONTROL, which points to the input record containing            49285000
      the new environmental status block.                               49290000
                                                                        49295000
                                                                        49300000
  OUTPUT PARAMETERS:                                                    49305000
                                                                        49310000
    B08'ENV'STATUS, which is the completion status of the               49315000
      procedure call.  A value of one is returned if no errors          49320000
      occurred.  Other values will be defined as required.              49325000
                                                                        49330000
                                                                        49335000
  SIDE-EFFECTS:                                                         49340000
                                                                        49345000
    After moving the data from the input record to the status           49350000
    tank, the input record will be set free.  Also, the flag            49355000
    in the cbix that indicates new status is available will be          49360000
    set.                                                                49365000
                                                                        49370000
                                                                        49375000
  SPECIAL CONSIDERATIONS:                                               49380000
                                                                        49385000
    When called, DB must be set to the base of the CIPER data           49390000
    segment.                                                            49395000
                                                                        49400000
                                                                        49405000
  CHANGE HISTORY:                                                       49410000
                                                                        49415000
    As issued.                                                          49420000
                                                                        49425000
;                                                                       49430000
                                                                        49435000
$PAGE "PROCEDURE:  B08'ENV'STATUS -- LOCAL DECLARATIONS"                49440000
begin                                                                   49445000
                                                                        49450000
  byte pointer                                                          49455000
                                                                        49460000
    old'status                                                          49465000
      << points to status tank >>                                       49470000
                                                                        49475000
   ,new'status                                                          49480000
      << points to new status in input record buffer >>                 49485000
                                                                        49490000
  ;                                                                     49495000
                                                                        49500000
                                                                        49505000
$PAGE "PROCEDURE:  B08'ENV'STATUS -- PROCEDURE BODY"                    49510000
  << First, set up the pointer to old and new status >>                 49515000
                                                                        49520000
  @old'status := ( cb'info(env'status'base)                             49525000
                   + cb'info(cds'area'base) ) to'byte;                  49530000
  @new'status := ( @i'r'control to'byte )                               49535000
               + i'r'control(current'position);                         49540000
                                                                        49545000
                                                                        49550000
  << Now move the information to the status tank >>                     49555000
                                                                        49560000
  move old'status := new'status,                                        49565000
                     (cb'info(device'env'status'size));                 49570000
                                                                        49575000
                                                                        49580000
  << Set the input record free >>                                       49585000
                                                                        49590000
  i'r'control(active) := free;                                          49595000
                                                                        49600000
                                                                        49605000
  << Set the new status available flag in the cbix >>                   49610000
                                                                        49615000
  cb'info(status'received).env'stat'bit := 1;                           49620000
  cb'info(status'reported).env'stat'bit := 0;                           49625000
                                                                        49630000
  << All done !! >>                                                     49635000
                                                                        49640000
  b08'env'status := successful;                                         49645000
                                                                        49650000
end;  << of procedure b08'env'status >>                                 49655000
                                                                        49660000
$PAGE "PROCEDURE:  B08'PROCESS'STATUS"                                  49665000
integer procedure b08'process'status(cb'info, i'r'control);             49670000
                                                                        49675000
  value                              cb'info, i'r'control ;             49680000
                                                                        49685000
  integer pointer                    cb'info, i'r'control ;             49690000
                                                                        49695000
  option privileged, uncallable                           ;             49700000
                                                                        49705000
                                                                        49710000
COMMENT                                                                 49715000
                                                                        49720000
  PURPOSE:                                                              49725000
                                                                        49730000
    This procedure determines if the current input record is            49735000
    any type of status, and if so, calls the appropriate status         49740000
    processing routine.  If the information is not status, it           49745000
    is ignored.                                                         49750000
                                                                        49755000
                                                                        49760000
  INPUT PARAMETERS:                                                     49765000
                                                                        49770000
    CB'INFO, which is a pointer to the control block informa-           49775000
      tion area.                                                        49780000
                                                                        49785000
    I'R'CONTROL, a pointer to the input record containing the           49790000
      data to be processed.                                             49795000
                                                                        49800000
                                                                        49805000
  OUTPUT PARAMETERS:                                                    49810000
                                                                        49815000
    B08'PROCESS'STATUS, which is a completion status for the            49820000
      call.  A value of one is returned if no errors occured.           49825000
      Other values will be defined as required.                         49830000
                                                                        49835000
                                                                        49840000
  SPECIAL CONSIDERATIONS:                                               49845000
                                                                        49850000
    None.                                                               49855000
                                                                        49860000
                                                                        49865000
  SPECIAL CONSIDERATIONS:                                               49870000
                                                                        49875000
    When called, DB must be set to the base of the CIPER data           49880000
    segment.                                                            49885000
                                                                        49890000
                                                                        49895000
  CHANGE HISTORY:                                                       49900000
                                                                        49905000
    As issued.                                                          49910000
                                                                        49915000
;                                                                       49920000
$PAGE "PROCEDURE:  B08'PROCESS'STATUS -- LOCAL DECLARATIONS"            49925000
begin                                                                   49930000
  << Declaration of local variables >>                                  49935000
                                                                        49940000
  integer pointer                                                       49945000
                                                                        49950000
    input'record                                                        49955000
      << points to base of input buffer area >>                         49960000
                                                                        49965000
  ;                                                                     49970000
                                                                        49975000
  integer                                                               49980000
    record'opcode                                                       49985000
   ,error'parm                                                          49990000
  ;                                                                     49995000
                                                                        50000000
$PAGE "PROCEDURE:  B08'PROCESS'STATUS -- PROCEDURE BODY"                50005000
  << Initialize local variables >>                                      50010000
                                                                        50015000
  @input'record := i'r'control(start) + @i'r'control;                   50020000
                                                                        50025000
  << get the opcode from the record >>                                  50030000
                                                                        50035000
  record'opcode := input'record(header'opcode);                         50040000
  i'r'control(current'position) :=                                      50045000
      i'r'control(current'position)                                     50050000
      + input'record(header'length);                                    50055000
                                                                        50060000
  if record'opcode = lgl'receive'ready then                             50065000
    begin                                                               50070000
      error'parm := b08'rcv'rdy(cb'info,i'r'control);                   50075000
    end                                                                 50080000
  else if record'opcode = lgl'status'report then                        50085000
    begin                                                               50090000
      error'parm := b08'device'status(cb'info,i'r'control);             50095000
    end                                                                 50100000
  else if record'opcode = lgl'job'report then                           50105000
    begin                                                               50110000
      error'parm := b08'job'report(cb'info, i'r'control);               50115000
    end                                                                 50120000
  else if record'opcode = lgl'esb'report then                           50125000
    begin                                                               50130000
      error'parm := b08'env'status(cb'info,i'r'control);                50135000
    end                                                                 50140000
  else                                                                  50145000
    begin                                                               50150000
      i'r'control(active) := integer(free);                             50155000
      error'parm := no'errors;                                          50160000
    end;                                                                50165000
                                                                        50170000
  b08'process'status := error'parm;                                     50175000
  return;                                                               50180000
                                                                        50185000
end;  << b08'process'status >>                                          50190000
                                                                        50195000
$PAGE "PROCEDURE:  CPR'GET'RECORD"                                      50200000
integer procedure cpr'get'record(cb'info, i'r'control,                  50205000
                                 expected'record'type);                 50210000
                                                                        50215000
  value                          cb'info, i'r'control,                  50220000
                                 expected'record'type ;                 50225000
                                                                        50230000
  integer pointer                cb'info, i'r'control ;                 50235000
                                                                        50240000
  integer                        expected'record'type ;                 50245000
                                                                        50250000
  option privileged, uncallable                       ;                 50255000
                                                                        50260000
                                                                        50265000
COMMENT                                                                 50270000
                                                                        50275000
  PURPOSE:                                                              50280000
                                                                        50285000
    This procedure will call the network level to obtain a              50290000
    logical record from the device.  The caller specifies the           50295000
    type of record desired, and cpr'get'record will not return          50300000
    anything else.  If the caller specifies a data record of            50305000
    some type, and a status record is received, then this               50310000
    procedure will call cpr'process'status to evaluate the              50315000
    status information, and will then issue another request to          50320000
    the transport service to get another record.  This will             50325000
    continue until the caller's request is satisfied.                   50330000
                                                                        50335000
                                                                        50340000
  INPUT PARAMETERS:                                                     50345000
                                                                        50350000
    CB'INFO, which is a pointer to the Level 7 control block            50355000
      information area of the CIPER data segment.                       50360000
                                                                        50365000
    I'R'CONTROL, which is a pointer to the input record to be           50370000
      used for the input transfer.                                      50375000
                                                                        50380000
    EXPECTED'RECORD'TYPE, which indicates the type of record            50385000
      the caller desires.                                               50390000
                                                                        50395000
                                                                        50400000
  OUTPUT PARAMETERS:                                                    50405000
                                                                        50410000
    ERROR'RETURN, which is the completion status of the call.           50415000
      If no errors occurred, then zero will be returned.  Other         50420000
      values will be defined as required.                               50425000
                                                                        50430000
                                                                        50435000
  SIDE-EFFECTS:                                                         50440000
                                                                        50445000
    Cpr'get'record will modify the control information of the           50450000
    input record buffer area.  It will also update the contents         50455000
    of the input'sequence'count contained in the control block.         50460000
                                                                        50465000
                                                                        50470000
  SPECIAL CONSIDERATIONS:                                               50475000
                                                                        50480000
    When called, DB must be set to the CIPER data segment that          50485000
    contains the Level 7 control block for the desired device.          50490000
                                                                        50495000
                                                                        50500000
  CHANGE HISTORY:                                                       50505000
                                                                        50510000
    8/31/83  Satish Janardan                                   <<07425>>50515000
                                                               <<07425>>50520000
    In the event of errors, execute a device clear only if not <<07425>>50525000
    already in progress.                                       <<07425>>50530000
                                                               <<07425>>50535000
    8/31/83  Chuck Mayne                                       <<07425>>50540000
                                                               <<07425>>50545000
    Added logging of records received from peripheral.         <<07425>>50550000
                                                                        50555000
;                                                                       50560000
                                                                        50565000
                                                                        50570000
begin                                                                   50575000
$PAGE "PROCEDURE:  CPR'GET'RECORD -- LOCAL VARIABLES"                   50580000
  << DECLARATION OF LOCAL VARIABLES >>                                  50585000
                                                                        50590000
                                                                        50595000
  integer pointer                                                       50600000
                                                                        50605000
    input'record                                                        50610000
      << pointer to base of input record buffer area >>                 50615000
                                                                        50620000
   ,control'table                                                       50625000
      << gets the address of our control table >>                       50630000
                                                                        50635000
  ;                                                                     50640000
                                                                        50645000
  double                                                                50650000
                                                                        50655000
    return'information                                                  50660000
      << Completion status from function calls >>                       50665000
                                                                        50670000
  ;                                                                     50675000
                                                                        50680000
  integer                                                               50685000
                                                                        50690000
    error'parm                    = return'information                  50695000
      << returns error information from other procedures >>             50700000
                                                                        50705000
   ,transfer'log                  = return'information + 1              50710000
      << Count on physical I/O >>                                       50715000
                                                                        50720000
  ;                                                                     50725000
                                                                        50730000
  logical                                                               50735000
                                                                        50740000
    got'expected                  := false                              50745000
      << flags reception of desired record type >>                      50750000
                                                                        50755000
  ;                                                                     50760000
                                                               <<07425>>50765000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>50770000
                                                               <<07425>>50775000
  integer pointer                                              <<07425>>50780000
                                                               <<07425>>50785000
    log'buffer                                                 <<07425>>50790000
      << points to logging buffer in cbix >>                   <<07425>>50795000
                                                               <<07425>>50800000
  ;                                                            <<07425>>50805000
                                                               <<07425>>50810000
                                                               <<07425>>50815000
  declare'move'to'data'segment;                                <<07425>>50820000
                                                               <<07425>>50825000
  declare'get'log'buffer;                                      <<07425>>50830000
                                                               <<07425>>50835000
  declare'put'le;                                              <<07425>>50840000
                                                               <<07425>>50845000
  declare'event'enabled;                                       <<07425>>50850000
                                                               <<07425>>50855000
$IF                                                            <<07425>>50860000
                                                               <<07425>>50865000
$PAGE "PROCEDURE:  CPR'GET'RECORD -- PROCEDURE BODY"                    50870000
  << Set up local variables >>                                          50875000
                                                                        50880000
  @input'record := i'r'control(start) + @i'r'control;                   50885000
  @control'table := cb'info(ct'ptr);                                    50890000
                                                                        50895000
                                                                        50900000
  << Check to see if the input record buffer area is clean. >>          50905000
  << If it is not, there is an internal problem that must   >>          50910000
  << be flagged.                                            >>          50915000
                                                                        50920000
  if logical(i'r'control(active)) then                                  50925000
    begin                                                               50930000
      << The buffer area was already in use when this re- >>            50935000
      << quest came in.  Flag an error and return.        >>            50940000
                                                                        50945000
      cpr'get'record := record'active'error;                            50950000
      return;                                                           50955000
    end                                                                 50960000
  else                                                                  50965000
    begin                                                               50970000
      << Since we are going to use it, set the active flag. >>          50975000
      << Also initialize certain control variables. >>                  50980000
                                                                        50985000
      i'r'control(active) := integer(in'use);                           50990000
    end;                                                                50995000
                                                                        51000000
  << Now start requesting records until the type we want     >>         51005000
  << comes in.  If the record we get is not what we want but >>         51010000
  << is some sort of device status, we will process it and   >>         51015000
  << then ask for another record.                            >>         51020000
                                                                        51025000
  do                                                                    51030000
    begin                                                               51035000
                                                                        51040000
      i'r'control(current'position) :=                                  51045000
          i'r'control(start) to'byte;                                   51050000
                                                                        51055000
      return'information :=                                             51060000
          b08'network'protocol( control'table,                          51065000
                                transport'read,                         51070000
                                @input'record,                          51075000
                                i'r'control(maximum'size),              51080000
                                cb'info(ciper'dst),                     51085000
                                cb'info(logical'device)    );           51090000
                                                                        51095000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>51100000
                                                               <<07425>>51105000
    if event'enabled(le'recv'record) then                      <<07425>>51110000
      begin                                                    <<07425>>51115000
        @log'buffer := get'log'buffer(log'buffer);             <<07425>>51120000
        log'buffer(log'entry'type) := le'recv'record;          <<07425>>51125000
        log'buffer(log'entry'data) := error'parm;              <<07425>>51130000
        log'buffer(log'entry'data+1) := transfer'log;          <<07425>>51135000
        move log'buffer(log'entry'data+2) :=                   <<07425>>51140000
          input'record,(5);                                    <<07425>>51145000
        put'le( log'buffer, 7 );                               <<07425>>51150000
      end;                                                     <<07425>>51155000
                                                               <<07425>>51160000
$IF                                                            <<07425>>51165000
                                                               <<07425>>51170000
                                                                        51175000
      << Update the current record length with the value >>             51180000
      << returned by Level 4                             >>             51185000
                                                                        51190000
      i'r'control(current'length) := transfer'log;                      51195000
                                                                        51200000
      << check the error'parm >>                                        51205000
      if error'parm.general <> no'errors then                           51210000
        begin                                                           51215000
          << transport service could not deliver a good  >>             51220000
          << record, so report that to a higher level    >>             51225000
                                                                        51230000
    I'R'CONTROL(ACTIVE) := INTEGER(FREE);                      <<07425>>51235000
          cpr'get'record := error'parm;                                 51240000
          return;                                                       51245000
        end                                                             51250000
      else                                                              51255000
        begin                                                           51260000
          << transport service gave us a complete record, >>            51265000
          << now we need to check its validity.           >>            51270000
                                                                        51275000
          if not logical( cb'info(dev'clr'in'progress) ) then           51280000
            begin                                                       51285000
              << Not doing a device clear, so check the seq- >>         51290000
              << uence number for validity.                  >>         51295000
                                                                        51300000
              if input'record(header'sequence'number)                   51305000
               = cb'info(input'sequence'count) then                     51310000
                begin                                                   51315000
                  << No error, update the counter >>                    51320000
                                                                        51325000
                  cb'info(input'sequence'count) :=                      51330000
                    (logical(cb'info(input'sequence'count)+1)           51335000
                    land 255);                                          51340000
                end                                                     51345000
              else                                                      51350000
                begin                                                   51355000
                  << There is an error.  If the device has   >>         51360000
                  << been reset and is sending status, ignor >>         51365000
                  << the error, as the status processor will >>         51370000
                  << take care of it.  Otherwise, do a       >>         51375000
                  << device clear to get back in synch.     >>          51380000
                                                                        51385000
                  if input'record(header'opcode) <>                     51390000
                     lgl'status'report                                  51395000
                  or (logical( input'record(parm'byte'2) )              51400000
                     land 1) <> 1 then                                  51405000
                    begin                                               51410000
                I'R'CONTROL(ACTIVE) := INTEGER(FREE);          <<07425>>51415000
                      error'parm :=                            <<07425>>51420000
                        b08'device'clear(cb'info, 1);          <<07425>>51425000
                      cpr'get'record := b08'worst'status(      <<07425>>51430000
                                        record'sequence'error, <<07425>>51435000
                                        error'parm);           <<07425>>51440000
                      return;                                           51445000
                    end;                                                51450000
                end;                                                    51455000
            end;                                                        51460000
                                                                        51465000
                                                                        51470000
          << Check the creator bit to ensure that the device >>         51475000
          << sent this record.                               >>         51480000
                                                                        51485000
          if input'record(header'creator) <> device then                51490000
            begin                                                       51495000
              << It appears that a host record wound up in  >>          51500000
              << the input buffer, so something is definit- >>          51505000
              << ly screwed up here!                        >>          51510000
                                                                        51515000
            if logical( cb'info(dev'clr'in'progress) ) then    <<07425>>51520000
              begin                                            <<07425>>51525000
              <<Doing a device clear, so report wrong creator>><<07425>>51530000
                                                               <<07425>>51535000
                i'r'control(active) := integer(free);          <<07425>>51540000
                cpr'get'record := wrong'creator;               <<07425>>51545000
                return;                                        <<07425>>51550000
              end                                              <<07425>>51555000
            else                                               <<07425>>51560000
              begin                                            <<07425>>51565000
                <<Do a device clear to clean up.            >> <<07425>>51570000
                                                               <<07425>>51575000
                i'r'control(active) := integer(free);          <<07425>>51580000
                error'parm :=                                  <<07425>>51585000
                  b08'device'clear(cb'info, 1);                <<07425>>51590000
                cpr'get'record := b08'worst'status(            <<07425>>51595000
                                 wrong'creator,                <<07425>>51600000
                                           error'parm);        <<07425>>51605000
                return;                                        <<07425>>51610000
              end;                                             <<07425>>51615000
            end;                                                        51620000
        end;  << of transport gave us a complete record ... >>          51625000
                                                                        51630000
                                                                        51635000
                                                                        51640000
      << We now have a valid record in the buffer.  If it   >>          51645000
      << belongs to the caller, return.  If it is not the   >>          51650000
      << caller's, but is status, process it.  If neither,  >>          51655000
      << throw it away and try again.                       >>          51660000
                                                                        51665000
      if expected'record'type = dont'care then                          51670000
        begin                                                           51675000
          << Caller wanted to look at anything that came in, >>         51680000
          << so return this record.                          >>         51685000
                                                                        51690000
          got'expected := true;                                         51695000
        end                                                             51700000
      else                                                              51705000
        begin                                                           51710000
          << Caller desired a particular type of record.     >>         51715000
          << Extract the record header information to deter- >>         51720000
          << mine if we have a match or not.                 >>         51725000
                                                                        51730000
          if input'record(header'opcode)                                51735000
              = expected'record'type then                               51740000
            begin                                                       51745000
              << We got what the caller asked for.  Return  >>          51750000
              << the record as is.                          >>          51755000
                                                                        51760000
              i'r'control(current'position) :=                          51765000
                  i'r'control(current'position) +                       51770000
                  input'record(header'length);                          51775000
              got'expected := true;                                     51780000
            end                                                         51785000
          else                                                          51790000
            begin                                                       51795000
              << The record is not what the caller wanted.  >>          51800000
              << See if it is status.                       >>          51805000
                                                                        51810000
              error'parm := B08'process'status(cb'info,                 51815000
                                i'r'control);                           51820000
                                                                        51825000
              << check the error'parm >>                                51830000
              if error'parm <> no'errors then                           51835000
                begin                                                   51840000
                  << Could not process the status.  Return >>           51845000
                  << appropriate error code.               >>           51850000
                                                                        51855000
                  cpr'get'record := error'parm;                         51860000
                  return;                                               51865000
                end;                                                    51870000
            end;  << of if opcode = expected'record'type >>             51875000
          end;  << of expected'record'type = dont'care ... >>           51880000
    end                                                                 51885000
  until got'expected;                                                   51890000
                                                                        51895000
  cpr'get'record := error'parm;                                         51900000
                                                                        51905000
end;  << of cpr'get'record >>                                           51910000
                                                                        51915000
$PAGE "PROCEDURE:  CPR'FORCE'RECORD"                                    51920000
integer procedure cpr'force'record(cb'info, o'r'control);               51925000
                                                                        51930000
  value                            cb'info, o'r'control ;               51935000
                                                                        51940000
  integer pointer                  cb'info, o'r'control ;               51945000
                                                                        51950000
  option privileged, uncallable                         ;               51955000
                                                                        51960000
                                                                        51965000
COMMENT                                                                 51970000
                                                                        51975000
  PURPOSE:                                                              51980000
                                                                        51985000
    Cpr'send'record provides a common interface for the logical         51990000
    driver to access the transport service by.  It maintains            51995000
    the information regarding the protocol between the logical          52000000
    driver and the logical device.  It always attempts to send          52005000
    the data contained in the output buffer area (that could            52010000
    change for the full blown implementation merely by passing          52015000
    a pointer to the desired record).                                   52020000
                                                                        52025000
                                                                        52030000
  INPUT PARAMETERS:                                                     52035000
                                                                        52040000
    CB'INFO, which is a pointer to the Level 7 control                  52045000
      block area of the CIPER data segment,                             52050000
                                                                        52055000
    O'R'CONTROL, which points to the output record to be sent.          52060000
                                                                        52065000
                                                                        52070000
  OUTPUT PARAMETERS:                                                    52075000
                                                                        52080000
    CPR'SEND'RECORD, which passes back the completion status of         52085000
      the call.  If no errors occurred, a value of zero will            52090000
      be returned.  Other values will be defined as required.           52095000
                                                                        52100000
                                                                        52105000
  SIDE-EFFECTS:                                                         52110000
                                                                        52115000
    CPR'SEND'RECORD will update certain information concerning          52120000
    the state of the Level 7 protocol.  This includes, but is           52125000
    not limited to, the RECEIVE READY count.  After a record            52130000
    is successfully sent, the output record buffer area will            52135000
    be cleaned up and initialized.                                      52140000
                                                                        52145000
                                                                        52150000
  SPECIAL CONSIDERATIONS:                                               52155000
                                                                        52160000
    When called, DB must be set to the CIPER data segment               52165000
    containing the Level 7 control block for the desired                52170000
    device.                                                             52175000
                                                                        52180000
                                                                        52185000
  CHANGE HISTORY:                                                       52190000
                                                                        52195000
    As issued.                                                          52200000
                                                                        52205000
;                                                                       52210000
                                                                        52215000
$PAGE "PROCEDURE:  CPR'FORCE'RECORD -- LOCAL VARIABLES"                 52220000
begin                                                                   52225000
  << DECLARATION OF LOCAL VARIABLES >>                                  52230000
                                                                        52235000
  integer pointer                                                       52240000
                                                                        52245000
    i'r'control                                                         52250000
      << pointer to input record control information >>                 52255000
      << only used if we need to get a Receive Ready before >>          52260000
      << we can send the data.                              >>          52265000
                                                                        52270000
   ,output'record                                                       52275000
      << pointer to output record buffer area >>                        52280000
                                                                        52285000
   ,control'table                                                       52290000
      << gets the address of the base of our control table >>           52295000
                                                                        52300000
  ;                                                                     52305000
                                                                        52310000
  double                                                                52315000
                                                                        52320000
    return'information                                                  52325000
      << Used for function value returns >>                             52330000
  ;                                                                     52335000
                                                                        52340000
  integer                                                               52345000
                                                                        52350000
    error'parm                    = return'information                  52355000
      << used to obtain error info from procedures called >>            52360000
                                                                        52365000
   ,transfer'log                  = return'information + 1              52370000
      << Transfer log of physical I/O >>                                52375000
                                                                        52380000
  ;                                                                     52385000
                                                                        52390000
  entry                                                                 52395000
                                                                        52400000
    cpr'send'record                                                     52405000
      << alternate entry point for normal protocol >>                   52410000
                                                                        52415000
  ;                                                                     52420000
                                                                        52425000
                                                                        52430000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>52435000
                                                               <<07425>>52440000
  integer pointer                                              <<07425>>52445000
                                                               <<07425>>52450000
    log'buffer                                                 <<07425>>52455000
      << points to logging buffer >>                           <<07425>>52460000
                                                               <<07425>>52465000
  ;                                                            <<07425>>52470000
                                                               <<07425>>52475000
                                                               <<07425>>52480000
  declare'move'to'data'segment;                                <<07425>>52485000
                                                               <<07425>>52490000
  declare'get'log'buffer;                                      <<07425>>52495000
                                                               <<07425>>52500000
  declare'put'le;                                              <<07425>>52505000
                                                               <<07425>>52510000
  declare'event'enabled;                                       <<07425>>52515000
                                                               <<07425>>52520000
$IF                                                            <<07425>>52525000
                                                               <<07425>>52530000
$PAGE "PROCEDURE:  CPR'FORCE'RECORD -- PROCEDURE BODY"                  52535000
  << If I/O is to be forced (can only be done for DEVICE    >>          52540000
  << CLEAR) then set RECEIVE READY count to one, so it will  >>         52545000
  << go to zero after this record is sent                    >>         52550000
                                                                        52555000
      cb'info(receive'ready'count) := 1;                                52560000
                                                                        52565000
cpr'send'record:                                                        52570000
                                                                        52575000
  << INITIALIZE LOCAL VARIABLES >>                                      52580000
                                                                        52585000
  @output'record := o'r'control(start) + @o'r'control;                  52590000
  @control'table := cb'info(ct'ptr);                                    52595000
                                                                        52600000
  << Make sure there is an active record to send.  If there >>          52605000
  << isn't, an internal error has occurred.                 >>          52610000
                                                                        52615000
  if not logical(o'r'control(active)) then                              52620000
    begin                                                               52625000
      << No active record. Call cpr'internal'error. >>                  52630000
                                                                        52635000
      cpr'force'record := record'active'error;                          52640000
      return;                                                           52645000
    end;                                                                52650000
                                                                        52655000
                                                                        52660000
  << now see if we can send the record to the device >>                 52665000
                                                                        52670000
  if cb'info(receive'ready'count) <= 0 then                             52675000
    begin                                                               52680000
      << no buffers available in the device.  Wait for a >>             52685000
      << RECEIVE READY to come in.                       >>             52690000
                                                                        52695000
      << Get an input record buffer >>                                  52700000
                                                                        52705000
      @i'r'control := cb'info(i'r'base)                                 52710000
                    + cb'info(cds'area'base);                           52715000
      if logical( i'r'control(active) ) then                            52720000
        begin                                                           52725000
          @i'r'control := b08'get'buffer( cb'info,                      52730000
                                      input'overwrite );                52735000
        end;                                                            52740000
                                                                        52745000
                                                                        52750000
      << Get a record from the transport service >>                     52755000
                                                                        52760000
      error'parm := cpr'get'record(cb'info,i'r'control,                 52765000
                                   lgl'receive'ready);                  52770000
                                                                        52775000
      << check the error'parm >>                                        52780000
      if error'parm <> no'errors then                                   52785000
        begin                                                           52790000
                                                                        52795000
                                                                        52800000
          << Free the record buffer area >>                             52805000
                                                                        52810000
          o'r'control(active) := integer(free);                         52815000
                                                                        52820000
                                                                        52825000
          b08'release'buffer(cb'info, i'r'control);                     52830000
          cpr'force'record := error'parm;                               52835000
          return;                                                       52840000
        end;                                                            52845000
                                                                        52850000
      << if no errors occurred, process the RECEIVE READY >>            52855000
      << report.                                          >>            52860000
      error'parm := b08'rcv'rdy(cb'info,i'r'control);                   52865000
      b08'release'buffer(cb'info, i'r'control);                         52870000
                                                                        52875000
      << check error'parm >>                                            52880000
      if error'parm <> no'errors then                                   52885000
        begin                                                           52890000
                                                                        52895000
                                                                        52900000
          << Free the record buffer area >>                             52905000
                                                                        52910000
          o'r'control(active) := integer(free);                         52915000
                                                                        52920000
                                                                        52925000
          cpr'force'record := error'parm;                               52930000
          return;                                                       52935000
        end;                                                            52940000
    end;  << of while receive'ready'count <= 0 ... >>                   52945000
                                                                        52950000
  << now that the device has buffers available, send the >>             52955000
  << output record.                                      >>             52960000
                                                                        52965000
  << Plug in the current value of the output sequence count >>          52970000
                                                                        52975000
  output'record(header'sequence'number) :=                              52980000
      cb'info(output'sequence'count);                                   52985000
                                                                        52990000
  return'information := b08'network'protocol(control'table,             52995000
      transport'write,@output'record,                                   53000000
      o'r'control(current'length),cb'info(ciper'dst),                   53005000
      cb'info(logical'device)  );                                       53010000
                                                                        53015000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>53020000
                                                               <<07425>>53025000
  if event'enabled(le'xmit'record) then                        <<07425>>53030000
    begin                                                      <<07425>>53035000
      @log'buffer := get'log'buffer(log'buffer);               <<07425>>53040000
      log'buffer(log'entry'type) := le'xmit'record;            <<07425>>53045000
      log'buffer(log'entry'data) := error'parm;                <<07425>>53050000
      log'buffer(log'entry'data+1) := transfer'log;            <<07425>>53055000
      move log'buffer(log'entry'data+2) := output'record,(5);  <<07425>>53060000
      put'le( log'buffer, 7 );                                 <<07425>>53065000
    end;                                                       <<07425>>53070000
                                                               <<07425>>53075000
$IF                                                            <<07425>>53080000
                                                               <<07425>>53085000
  << check the error'parm >>                                            53090000
  if error'parm = no'errors then                                        53095000
    begin                                                               53100000
      << Record was sent successfully, so decrement the >>              53105000
      << receive ready count and mark the record buffer >>              53110000
      << as available.  Also increment the record se-   >>              53115000
      << quence number for the next record.             >>              53120000
                                                                        53125000
      cb'info(receive'ready'count) :=                                   53130000
          cb'info(receive'ready'count) - 1;                             53135000
                                                                        53140000
      cb'info(output'sequence'count) :=                                 53145000
          ( logical( cb'info(output'sequence'count) + 1 )               53150000
            land 255 );                                                 53155000
                                                                        53160000
    end;                                                                53165000
                                                                        53170000
                                                                        53175000
  << Free the record buffer area >>                                     53180000
                                                                        53185000
  o'r'control(active) := integer(free);                                 53190000
                                                                        53195000
                                                                        53200000
  << Set up the error return information >>                             53205000
                                                                        53210000
  cpr'force'record := error'parm;                                       53215000
                                                                        53220000
end;  << cpr'force'record >>                                            53225000
                                                                        53230000
$PAGE "PROCEDURE:  B08'BUILD'HEADER"                                    53235000
procedure b08'build'header( o'r'control, opcode,                        53240000
                            data'type,                         <<04422>>53245000
                            block'start, block'end);           <<04422>>53250000
                                                                        53255000
  value                     o'r'control, opcode,                        53260000
                            data'type,                         <<04422>>53265000
                            block'start, block'end ;           <<04422>>53270000
  integer pointer           o'r'control           ;                     53275000
                                                                        53280000
  integer                                opcode,                        53285000
                            data'type,                         <<04422>>53290000
                            block'start, block'end ;           <<04422>>53295000
                                                               <<04422>>53300000
  option privileged, uncallable, variable          ;           <<04422>>53305000
                                                                        53310000
                                                                        53315000
                                                                        53320000
COMMENT                                                                 53325000
                                                                        53330000
  PURPOSE:                                                              53335000
                                                                        53340000
    This procedure will build the record header for all types           53345000
    of records.  Currently, we are using a four byte header:            53350000
                                                                        53355000
        byte 0 ==> header length                                        53360000
        byte 1 ==> record sequence number                               53365000
        byte 2 ==> record opcode                                        53370000
        byte 3 ==> host/peripheral flag, start of block flag,           53375000
                   end of block flag, and data type code.               53380000
                                                                        53385000
    In addition, for debugging purposes, the entire record              53390000
    buffer area will be zeroed out so new data will be easier           53395000
    to see as it gets filled in.                                        53400000
                                                                        53405000
                                                                        53410000
  INPUT PARAMETERS:                                                     53415000
                                                                        53420000
    O'R'CONTROL, which points to the control portion of the             53425000
      record buffer area currently in use.  The control portion         53430000
      maintains the maximum size of the output record, its              53435000
      current size, next available byte location, and other             53440000
      information.                                                      53445000
                                                                        53450000
    OPCODE, which is the record opcode to be inserted into the          53455000
      record header.                                                    53460000
                                                                        53465000
    DATA'TYPE, which is the associated data type of the record.         53470000
      Many of the record types do not use this field, so a              53475000
      zero is passed in in its place.                                   53480000
                                                               <<04422>>53485000
    BLOCK'START, which is an optional parameter that, if pre-  <<04422>>53490000
      sent, indicates the value that the start of block flag   <<04422>>53495000
      will take on.  If not present, the start of block bit in <<04422>>53500000
      the header is cleared.                                   <<04422>>53505000
                                                               <<04422>>53510000
    BLOCK'END, which is an optional parameter that, if present,<<04422>>53515000
      indicates the value that the end of block bit in the re- <<04422>>53520000
      cord header will take on.  If not present, the end of    <<04422>>53525000
      block bit is cleared.                                    <<04422>>53530000
                                                                        53535000
                                                                        53540000
  OUTPUT PARAMETERS:                                                    53545000
                                                                        53550000
    None.                                                               53555000
                                                                        53560000
                                                                        53565000
  SIDE-EFFECTS:                                                         53570000
                                                                        53575000
    The entire record buffer data area will be set to zero.             53580000
    The current length will be set to three, and the current            53585000
    position (next available byte) will be set past the head-           53590000
    er.                                                                 53595000
                                                                        53600000
                                                                        53605000
  SPECIAL CONSIDERATIONS:                                               53610000
                                                                        53615000
    None.                                                               53620000
                                                                        53625000
                                                                        53630000
  CHANGE HISTORY:                                                       53635000
                                                                        53640000
    As issued.                                                          53645000
                                                                        53650000
;                                                                       53655000
$PAGE "PROCEDURE:  B08'BUILD'HEADER -- LOCAL VARIABLES"                 53660000
begin                                                                   53665000
                                                                        53670000
  integer pointer                                                       53675000
                                                                        53680000
    o'r'data                                                            53685000
      << points to data portion of the output record >>                 53690000
                                                                        53695000
  ;                                                                     53700000
                                                               <<04422>>53705000
                                                               <<04422>>53710000
  define                                                       <<04422>>53715000
                                                               <<04422>>53720000
    block'start'flag              = (14: 1) #                  <<04422>>53725000
                                                               <<04422>>53730000
   ,block'end'flag                = (15: 1) #                  <<04422>>53735000
                                                               <<04422>>53740000
   ,data'type'                    = (13: 1) #                  <<04422>>53745000
                                                               <<04422>>53750000
  ;                                                            <<04422>>53755000
$PAGE "PROCEDURE:  B08'BUILD'HEADER -- PROCEDURE BODY"                  53760000
                                                                        53765000
  << First, initialize the pointer to the data area >>                  53770000
                                                                        53775000
  @o'r'data := o'r'control(start) + @o'r'control;                       53780000
                                                                        53785000
                                                                        53790000
  << Mark the record buffer active and initialize the >>                53795000
  << length and current position indicators           >>                53800000
                                                                        53805000
  o'r'control(active) := in'use;                                        53810000
  o'r'control(current'length) := rec'head'length;                       53815000
  o'r'control(current'position) :=                                      53820000
      ( o'r'control(start) to'byte ) + rec'head'length;                 53825000
                                                                        53830000
$IF X9 = ON  << ON = INCLUDE DEBUGGING CODE >>                          53835000
                                                                        53840000
  << Clear out the record buffer data area.  This will >>               53845000
  << make it easier to determine where new data is going. >>            53850000
                                                                        53855000
  o'r'data := 0;                                                        53860000
  move o'r'data(1) := o'r'data(0),(o'r'control(maximum'size)/2-1);      53865000
                                                                        53870000
$IF                                                                     53875000
                                                                        53880000
                                                                        53885000
  << Fill in the record header information, including the  >>           53890000
  << opcode passed in.                                     >>           53895000
                                                                        53900000
  o'r'data(header'length) := rec'head'length;                           53905000
  o'r'data(header'creator) := host;                                     53910000
  o'r'data(header'opcode) := opcode;                                    53915000
                                                               <<04422>>53920000
  o'r'data(type'of'data) := if parm'mask.data'type'            <<04422>>53925000
                               then data'type                  <<04422>>53930000
                               else no'data'type'used;         <<04422>>53935000
                                                                        53940000
                                                                        53945000
  << Set up the start of block and end of block as required >> <<04422>>53950000
                                                                        53955000
  o'r'data(sob'flag) := if parm'mask.block'start'flag          <<04422>>53960000
                          then block'start                     <<04422>>53965000
                          else clear'bit;                      <<04422>>53970000
                                                               <<04422>>53975000
  o'r'data(eob'flag) := if parm'mask.block'end'flag            <<04422>>53980000
                          then block'end                       <<04422>>53985000
                          else clear'bit;                      <<04422>>53990000
                                                                        53995000
                                                                        54000000
  << All finished >>                                                    54005000
                                                                        54010000
end;  << of procedure b08'build'header >>                               54015000
                                                                        54020000
$PAGE "  PROCEDURE:  B08'READ'DATA"                                     54025000
double procedure b08'read'data( cb'info, dst'num, address,              54030000
                                count, parm1, parm2, flags);            54035000
                                                                        54040000
  value                         cb'info, dst'num, address,              54045000
                                count, parm1, parm2, flags ;            54050000
                                                                        54055000
  integer pointer               cb'info                    ;            54060000
                                                                        54065000
  integer                                dst'num, address,              54070000
                                count, parm1, parm2, flags ;            54075000
                                                                        54080000
  option privileged, uncallable                            ;            54085000
                                                                        54090000
                                                                        54095000
COMMENT                                                                 54100000
                                                                        54105000
    This procedure has not been implemented for the 2608S               54110000
    line printer.  The function of 'read data' is not fully             54115000
    defined as yet by the CIPER task force.  This procedure             54120000
    stub has been used merely as a place holder for a future            54125000
    full implementation.                                                54130000
                                                                        54135000
;                                                                       54140000
                                                                        54145000
                                                                        54150000
                                                                        54155000
begin                                                                   54160000
                                                                        54165000
  double                                                                54170000
                                                                        54175000
    return'information             = b08'read'data                      54180000
                                                                        54185000
  ;                                                                     54190000
                                                                        54195000
                                                                        54200000
  integer                                                               54205000
                                                                        54210000
    return'status                  = b08'read'data                      54215000
                                                                        54220000
   ,transfer'log                   = b08'read'data + 1                  54225000
                                                                        54230000
  ;                                                                     54235000
                                                                        54240000
                                                                        54245000
  return'status := invalid'function;                                    54250000
                                                                        54255000
end;  << of procedure b08'read'data >>                                  54260000
                                                                        54265000
$PAGE "PROCEDURE:  B08'WRITE'DATA"                                      54270000
double  procedure b08'write'data(cb'info, dst'num, address,             54275000
                                 function, count, parm1, parm2,         54280000
                                 flags, output'data'type,               54285000
                                 expanded'features'flag,                54290000
                                 translate'flag              );         54295000
                                                                        54300000
  value                          cb'info, dst'num, address,             54305000
                                 function, count, parm1, parm2,         54310000
                                 flags, output'data'type,               54315000
                                 expanded'features'flag ,               54320000
                                 translate'flag               ;         54325000
                                                                        54330000
  integer pointer                cb'info                      ;         54335000
                                                                        54340000
  integer                                 dst'num, address,             54345000
                                 function, count, parm1, parm2,         54350000
                                 flags, output'data'type      ;         54355000
                                                                        54360000
  logical                        expanded'features'flag,                54365000
                                 translate'flag               ;         54370000
                                                                        54375000
  option privileged, uncallable                               ;         54380000
                                                                        54385000
                                                                        54390000
                                                                        54395000
COMMENT                                                                 54400000
                                                                        54405000
  PURPOSE:                                                              54410000
                                                                        54415000
    This procedure will cause the conversion of parm1 and parm2         54420000
    parameters into device escape sequences.  These commands            54425000
    are then merged with any data the caller has provided.              54430000
    This information is placed in the output record buffer, and         54435000
    when that buffer is full it will be sent to the device.             54440000
                                                                        54445000
                                                                        54450000
  INPUT PARAMETERS:                                                     54455000
                                                                        54460000
                                                                        54465000
    CB'INFO, which is a pointer to the Level 7 control block            54470000
      information area of the CIPER data segment.                       54475000
                                                                        54480000
    DST'NUM, which is the data segment number of the source             54485000
      of the caller's data, if it is not located in a system            54490000
      buffer.                                                           54495000
                                                                        54500000
    ADDRESS, which is either an offset into the source data             54505000
      segment, or a system buffer index, depending on the sys-          54510000
      tem buffer bit in the flags parameter.                            54515000
                                                                        54520000
    COUNT, which is the length of the caller's data, if any.            54525000
      If count is positive, it specifies a word count, if neg-          54530000
      ative, it specifies a byte count.                                 54535000
                                                                        54540000
    PARM1, which is a request dependent (for example, with              54545000
      'write' requests, it specifies the carriage control).             54550000
                                                                        54555000
    PARM2, which is a second request dependent parameter.               54560000
                                                                        54565000
    FLAGS, which contain control and specification fields.              54570000
                                                                        54575000
    OUTPUT'DATA'TYPE, which specifies the type of data record           54580000
      to build and/or append to with the data generated by the          54585000
      call.                                                             54590000
                                                                        54595000
    EXPANDED'FEATURES'FLAG, which specifies the access mode             54600000
      of the user.  If true, the caller can access the features         54605000
      of the device via commands imbedded in the data.  If              54610000
      false, any commands imbedded in the caller's data will be         54615000
      ignored by the device.                                            54620000
                                                                        54625000
    TRANSLATE'FLAG, which control whether or not the function           54630000
      code translator will be called.                                   54635000
                                                                        54640000
                                                                        54645000
  OUTPUT PARAMETERS:                                                    54650000
                                                                        54655000
    B08'WRITE'DATA, which is a double word function return.             54660000
      The most significant word is the completion status of the         54665000
      call.  The least significant word is the transfer log of          54670000
      data moved from the caller to the record buffer.                  54675000
                                                                        54680000
                                                                        54685000
  SIDE-EFFECTS:                                                         54690000
                                                                        54695000
    B08'write'data modifies the output record buffer directly           54700000
      as it moves information into the buffer.  In addition,            54705000
      if a record is sent to the device, then other status in-          54710000
      formation may be altered, as status reports, etc. come            54715000
      in from the device.                                               54720000
                                                                        54725000
                                                                        54730000
  SPECIAL CONSIDERATIONS:                                               54735000
                                                                        54740000
    When called, DB must be pointing to the CIPER data segment.         54745000
                                                                        54750000
                                                                        54755000
  CHANGE HISTORY:                                                       54760000
                                                                        54765000
    As issued.                                                          54770000
                                                                        54775000
                                                                        54780000
;                                                                       54785000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- LOCAL VARIABLES"                   54790000
begin                                                                   54795000
                                                                        54800000
  << DECLARATION OF LOCAL VARIABLES >>                                  54805000
                                                                        54810000
  integer pointer                                                       54815000
                                                                        54820000
    o'r'control                                                         54825000
      << points to output record control information >>                 54830000
                                                                        54835000
   ,output'record                                                       54840000
      << base of output record buffer area >>                           54845000
                                                                        54850000
   ,next'word                                                           54855000
      << address of next word of buffer to move data into >>            54860000
  ;                                                                     54865000
  byte pointer                                                          54870000
    output'position                                                     54875000
      << current position in output record >>                           54880000
   ,seq'1'buff                                                          54885000
      << byte array for leading escape sequence(s) >>                   54890000
   ,seq'2'buff                                                          54895000
      << byte array for trailing escape sequence(s) >>                  54900000
  ;                                                                     54905000
                                                                        54910000
                                                                        54915000
  << Function return subparameters: >>                                  54920000
                                                                        54925000
  integer                                                               54930000
                                                                        54935000
    return'status                 = b08'write'data                      54940000
      << Completion status of procedure execution >>                    54945000
                                                                        54950000
   ,transfer'log                  = b08'write'data + 1                  54955000
      << Final count of data moved from caller's buffer >>              54960000
                                                                        54965000
  ;                                                                     54970000
                                                                        54975000
                                                                        54980000
                                                                        54985000
  double                                                                54990000
                                                                        54995000
    return'information                                                  55000000
      << Used for return variable from procedure calls. >>              55005000
  ;                                                                     55010000
                                                                        55015000
  integer                                                               55020000
                                                                        55025000
    error'parm                    = return'information                  55030000
      << Contains error return information from procedure >>            55035000
      << calls.                                           >>            55040000
                                                                        55045000
   ,sequence'counts               = return'information + 1              55050000
      << Contains the byte counts of the leading escape se-  >>         55055000
      << quence (upper byte) and trailing escape sequence    >>         55060000
      << (lower byte) returned from cpr'xlate.               >>         55065000
                                                                        55070000
  ;                                                                     55075000
                                                                        55080000
  define                                                                55085000
                                                                        55090000
    upper'byte                    = ( 0: 8) #                           55095000
   ,lower'byte                    = ( 8: 8) #                           55100000
  ;                                                                     55105000
                                                                        55110000
  integer                                                               55115000
                                                                        55120000
    seq'1'count                                                         55125000
      << byte count of leading escape sequence(s) >>                    55130000
                                                                        55135000
   ,seq'2'count                                                         55140000
      << byte count of trailing escape sequence(s) >>                   55145000
                                                                        55150000
   ,move'count                                                          55155000
      << word count for move from user's data segment >>                55160000
                                                                        55165000
   ,byte'count                                                          55170000
      << user's count converted to number of bytes >>                   55175000
                                                                        55180000
   ,what'fits                                                           55185000
      << amount of space left in record >>                              55190000
                                                                        55195000
   ,offset                                                              55200000
      << number of bytes to compact out, if any, after data >>          55205000
      << has been moved out of the caller's data segment.   >>          55210000
                                                                        55215000
   ,total'moved                                                         55220000
      << tally of all bytes moved into record buffer >>                 55225000
                                                                        55230000
  ;                                                                     55235000
                                                                        55240000
                                                                        55245000
  logical                                                               55250000
                                                                        55255000
    cctl                                                                55260000
      << flag that user specified first column carriage con- >>         55265000
      << trol (carriage control is first byte of data).      >>         55270000
                                                                        55275000
   ,address'odd                                                         55280000
      << used to flag that record buffer address is on an >>            55285000
      << odd byte boundary -- important for mfds and mtds >>            55290000
      << instructions                                     >>            55295000
                                                                        55300000
  ;                                                                     55305000
                                                                        55310000
                                                                        55315000
  declare'move'from'data'segment;                                       55320000
                                                                        55325000
$PAGE "PROCEDURE:  B08'WRITE'DATA --  SUBROUTINE:  BUILD'DATA'RECORD"   55330000
integer subroutine build'data'record(requested'data'type);              55335000
                                                                        55340000
  value                              requested'data'type ;              55345000
                                                                        55350000
  integer                            requested'data'type ;              55355000
                                                                        55360000
begin                                                                   55365000
                                                                        55370000
COMMENT                                                                 55375000
                                                                        55380000
  PURPOSE:                                                              55385000
                                                                        55390000
    This subroutine will initialize the output record area              55395000
    and build a record header for a data record.  In addition,          55400000
    the data type parameter will be set to the type passed in           55405000
    by the caller.                                                      55410000
                                                                        55415000
                                                                        55420000
  INPUT PARAMETERS:                                                     55425000
                                                                        55430000
    REQUESTED'DATA'TYPE, which is a code for the type of data.          55435000
      This value will be plugged in as the first parameter              55440000
      byte of the data record.                                          55445000
                                                                        55450000
                                                                        55455000
  OUTPUT PARAMETERS:                                                    55460000
                                                                        55465000
    ERROR'RETURN, which returns the results of this call to             55470000
      build'data'record.  A value of zero indicates no                  55475000
      errors.  Other values will be defined as required.                55480000
                                                                        55485000
                                                                        55490000
  SIDE-EFFECTS:                                                         55495000
                                                                        55500000
    Build'data'record initializes all associated output record          55505000
    parameters as it sets up a new record.                              55510000
                                                                        55515000
                                                                        55520000
  SPECIAL CONSIDERATIONS:                                               55525000
                                                                        55530000
    None.                                                               55535000
                                                                        55540000
  CHANGE HISTORY:                                                       55545000
                                                                        55550000
    As issued.                                                          55555000
                                                                        55560000
;                                                                       55565000
                                                                        55570000
$PAGE                                                                   55575000
  << BODY OF SUBROUTINE >>                                              55580000
                                                                        55585000
  << First check to make sure the output record is not >>               55590000
  << active.  If it is, then the previous record was   >>               55595000
  << not successfully sent, and this subroutine should >>               55600000
  << not try to initialize the area.                   >>               55605000
                                                                        55610000
  if logical(o'r'control(active)) then                                  55615000
    begin                                                               55620000
      << previous record not sent, return with error >>                 55625000
                                                                        55630000
      build'data'record := record'active'error;                         55635000
      return;                                                           55640000
                                                                        55645000
    end;                                                                55650000
                                                                        55655000
  << If the record area is inactive, then build the record >>           55660000
  << header.                                               >>           55665000
                                                                        55670000
  b08'build'header( o'r'control,                                        55675000
                    lgl'write,                                          55680000
                    requested'data'type );                              55685000
                                                                        55690000
                                                                        55695000
  @output'position := o'r'control(current'position)                     55700000
                    + (@o'r'control to'byte);                           55705000
                                                                        55710000
                                                                        55715000
  << All done, so set return code and exit >>                           55720000
                                                                        55725000
  build'data'record := no'errors;                                       55730000
                                                                        55735000
end; << of subroutine build'data'record >>                              55740000
                                                                        55745000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- SUBROUTINE:  SEND'THEN'BUILD"      55750000
integer subroutine send'then'build(requested'data'type);                55755000
                                                                        55760000
  value                            requested'data'type ;                55765000
                                                                        55770000
  integer                          requested'data'type ;                55775000
                                                                        55780000
                                                                        55785000
COMMENT                                                                 55790000
                                                                        55795000
  PURPOSE:                                                              55800000
                                                                        55805000
    This subroutine will call cpr'send'record to flush out a            55810000
    full record buffer, and then build a new record of the              55815000
    same data type as the previous record.  If any errors               55820000
    occur, the error'parm is returned to the caller for eval-           55825000
    uation.                                                             55830000
                                                                        55835000
                                                                        55840000
  INPUT PARAMETERS:                                                     55845000
                                                                        55850000
    REQUESTED'DATA'TYPE, which is the data type of the new              55855000
      record.                                                           55860000
                                                                        55865000
                                                                        55870000
  OUTPUT PARAMETERS:                                                    55875000
                                                                        55880000
    ERROR'RETURN, which is a status return variable.  A value           55885000
      of zero indicates no errors.  Other values will be defined        55890000
      as required.                                                      55895000
                                                                        55900000
                                                                        55905000
  SIDE-EFFECTS:                                                         55910000
                                                                        55915000
    Causes transmission of output record data, with attendent           55920000
    updating of certain device status information.                      55925000
                                                                        55930000
                                                                        55935000
  SPECIAL CONSIDERATIONS:                                               55940000
                                                                        55945000
    None.                                                               55950000
                                                                        55955000
  CHANGE HISTORY:                                                       55960000
                                                                        55965000
    As issued.                                                          55970000
                                                                        55975000
                                                                        55980000
  ;                                                                     55985000
                                                                        55990000
$PAGE                                                                   55995000
begin  << subroutine send'then'build >>                                 56000000
                                                                        56005000
  x := cpr'send'record(cb'info,o'r'control);                            56010000
                                                                        56015000
  << check the error return >>                                          56020000
  if x = no'errors then                                                 56025000
    begin                                                               56030000
      << if no errors, try to build a new record >>                     56035000
                                                                        56040000
      send'then'build := build'data'record(requested'data'type);        56045000
    end                                                                 56050000
  else                                                                  56055000
    begin                                                               56060000
      << There was an error.  Store the value in x back >>              56065000
      << into the return variable.                        >>            56070000
                                                                        56075000
      send'then'build := x;                                             56080000
    end;                                                                56085000
end;  << of subroutine send'then'build >>                               56090000
                                                                        56095000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- SUBROUTINE:  MOVE'INTERNAL'DATA"   56100000
integer subroutine move'internal'data(data'address,data'count);         56105000
                                                                        56110000
  value                               data'address,data'count ;         56115000
                                                                        56120000
  byte pointer                        data'address            ;         56125000
                                                                        56130000
  integer                                          data'count ;         56135000
                                                                        56140000
COMMENT                                                                 56145000
                                                                        56150000
  PURPOSE:                                                              56155000
                                                                        56160000
    This subroutine will move internal data (i.e. xlator                56165000
    generated escape sequences) into the output record buffer           56170000
    area.  If the size of that data causes the record to be-            56175000
    come full, send'then'build will be called to transfer the           56180000
    record to the device and construct a new record.                    56185000
                                                                        56190000
                                                                        56195000
  INPUT PARAMETERS:                                                     56200000
                                                                        56205000
    DATA'ADDRESS, which is a byte pointer to the starting               56210000
      position of the data to be moved into the output record.          56215000
                                                                        56220000
    DATA'COUNT, which is the byte count of the data to be               56225000
      moved.                                                            56230000
                                                                        56235000
                                                                        56240000
  OUTPUT PARAMETERS:                                                    56245000
                                                                        56250000
    None.                                                               56255000
                                                                        56260000
                                                                        56265000
  SIDE-EFFECTS:                                                         56270000
                                                                        56275000
    This subroutine will always modify the record control               56280000
    variables current'position, current'length, and the record          56285000
    pointer output'position.  In addition, since it is possible         56290000
    that a record may become full and have to be sent to the            56295000
    device, other information concerning the state of the de-           56300000
    vice and the communication protocol may be altered.                 56305000
                                                                        56310000
                                                                        56315000
  SPECIAL CONSIDERATIONS:                                               56320000
                                                                        56325000
    None.                                                               56330000
                                                                        56335000
                                                                        56340000
  CHANGE HISTORY:                                                       56345000
                                                                        56350000
    As issued.                                                          56355000
                                                                        56360000
                                                                        56365000
;                                                                       56370000
                                                                        56375000
$PAGE                                                                   56380000
begin  << subroutine move'internal'data >>                              56385000
                                                                        56390000
  while data'count > 0 do                                               56395000
    begin                                                               56400000
      << There is some data to be moved.  First determine >>            56405000
      << how much (if any) will fit into the currently    >>            56410000
      << active record.                                   >>            56415000
                                                                        56420000
      if o'r'control(current'length) + data'count >                     56425000
          o'r'control(maximum'size) then                                56430000
        begin                                                           56435000
          << only part of the data will fit.  Calculate how >>          56440000
          << much we can move this pass.                    >>          56445000
                                                                        56450000
          what'fits := o'r'control(maximum'size) -                      56455000
              o'r'control(current'length);                              56460000
        end                                                             56465000
      else                                                              56470000
        begin                                                           56475000
          << the entire thing will fit, so set up to move it >>         56480000
          << all this time                                   >>         56485000
                                                                        56490000
          what'fits := data'count;                                      56495000
        end;                                                            56500000
                                                                        56505000
      << now reduce data'count by what we are going to move >>          56510000
      data'count := data'count - what'fits;                             56515000
                                                                        56520000
      << move the data into the record >>                               56525000
      move output'position := data'address,(what'fits);                 56530000
      @data'address := @data'address + what'fits;                       56535000
      @output'position := @output'position + what'fits;                 56540000
                                                                        56545000
      << update the record control information >>                       56550000
      o'r'control(current'position) := @output'position                 56555000
                                     - @o'r'control to'byte;            56560000
      o'r'control(current'length) := o'r'control                        56565000
          (current'length) + what'fits;                                 56570000
                                                                        56575000
      << now see if the record should be sent or not >>                 56580000
      if o'r'control(current'length) = o'r'control                      56585000
          (maximum'size) then                                           56590000
        begin                                                           56595000
          << time to send the record to the device >>                   56600000
                                                                        56605000
          x := send'then'build(output'data'type);                       56610000
                                                                        56615000
          << check the error'parm >>                                    56620000
          if x <> no'errors then                                        56625000
            begin                                                       56630000
              move'internal'data := x;                                  56635000
              return;                                                   56640000
            end;                                                        56645000
        end;  << of current'length = maximum'size ... >>                56650000
                                                                        56655000
    end;  << of while data'count > 0 ... >>                             56660000
                                                                        56665000
    move'internal'data := no'errors;                                    56670000
                                                                        56675000
end;  << of subroutine move'internal'data  >>                           56680000
                                                                        56685000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- PROCEDURE BODY"                    56690000
  << First, initialize the local variables used >>                      56695000
                                                                        56700000
  total'moved := 0;                                                     56705000
                                                                        56710000
  @o'r'control := cb'info(o'r'base) + cb'info(cds'area'base);           56715000
  @output'record := o'r'control(start) + @o'r'control;                  56720000
  @output'position := o'r'control(current'position)                     56725000
                    + @o'r'control to'byte;                             56730000
  @seq'1'buff := cb'info(sequence'1'buffer)                             56735000
               + cb'info(cds'area'base) to'byte;                        56740000
  @seq'2'buff := @seq'1'buff + xlator'buff'size;                        56745000
                                                                        56750000
  << Next, determine if there is a record already under >>              56755000
  << construction, and if so, is it of the proper data >>               56760000
                                                                        56765000
  if logical(o'r'control(active)) then                                  56770000
    begin                                                               56775000
      << there is a record in the process of assembly. >>               56780000
      << check to see if it is of the same data type as >>              56785000
      << this request.                                 >>               56790000
                                                                        56795000
      if output'record(type'of'data) <> output'data'type then           56800000
        begin                                                           56805000
          << new request is not of same type as current >>              56810000
          << record, so we must send the existing record >>             56815000
          << and build a new one for this request        >>             56820000
                                                                        56825000
          error'parm := cpr'send'record(cb'info,o'r'control);           56830000
                                                                        56835000
          << check error'parm for problems >>                           56840000
          if error'parm <> no'errors then                               56845000
            begin                                                       56850000
              return'status := error'parm;                              56855000
              return;                                                   56860000
            end;                                                        56865000
                                                                        56870000
          << now create new record header for this type of >>           56875000
          << data.                                         >>           56880000
          error'parm := build'data'record(output'data'type);            56885000
                                                                        56890000
          << check error'parm for problems >>                           56895000
          if error'parm <> no'errors then                               56900000
            begin                                                       56905000
              return'status := error'parm;                              56910000
              return;                                                   56915000
            end;                                                        56920000
        end;                                                            56925000
    end  << of logical(output'record(active)) = true >>                 56930000
  else                                                                  56935000
    begin                                                               56940000
      << there is no record active, so create a new one >>              56945000
                                                                        56950000
      error'parm := build'data'record(output'data'type);                56955000
                                                                        56960000
      << check error'parm for problems >>                               56965000
      if error'parm <> no'errors then                                   56970000
        begin                                                           56975000
          return'status := error'parm;                                  56980000
          return;                                                       56985000
        end;                                                            56990000
                                                                        56995000
    end;  << of logical(output'record(active)) <> true >>               57000000
                                                                        57005000
                                                                        57010000
                                                                        57015000
  << Convert the count the caller specified to a byte >>                57020000
  << count (positive, of course)                      >>                57025000
                                                                        57030000
  if count < 0 then                                                     57035000
    begin                                                               57040000
      << user specified bytes, so just negate >>                        57045000
                                                                        57050000
      byte'count := -count;                                             57055000
    end                                                                 57060000
  else                                                                  57065000
    begin                                                               57070000
      << user specified words, so convert >>                            57075000
                                                                        57080000
      byte'count := count to'byte;                                      57085000
    end;                                                                57090000
                                                                        57095000
                                                                        57100000
  << If the caller specified system buffers, then set up >>             57105000
  << the initial information in sbuf'info.               >>             57110000
                                                                        57115000
  if logical( flags.system'buffers ) then                               57120000
    begin                                                               57125000
      dst'num := sbuf'dst;                                              57130000
      if byte'count > 256 then byte'count := 256;                       57135000
    end;                                                                57140000
                                                                        57145000
                                                                        57150000
                                                                        57155000
  << If the function is a write, and the user specified that >>         57160000
  << the carriage control character is in the data buffer,   >>         57165000
  << then that word must be moved in and the upper byte used >>         57170000
  << as parm1 for the translator procedure.                  >>         57175000
                                                                        57180000
  if function = write and parm1 = 1 then                                57185000
    begin                                                               57190000
                                                                        57195000
      << Set cctl true, so we can remember later that the >>            57200000
      << first byte of the data is to be removed.         >>            57205000
                                                                        57210000
      cctl := true;                                                     57215000
                                                                        57220000
      << Temporarily use the pointer next'word and the    >>            57225000
      << translator buffer to move the first word of the  >>            57230000
      << caller's buffer in.                              >>            57235000
                                                                        57240000
      @next'word := @seq'1'buff to'word;                                57245000
                                                                        57250000
      mfds(next'word, dst'num, address, 1);                             57255000
                                                                        57260000
      parm1 := next'word.upper'byte;                                    57265000
                                                                        57270000
    end                                                                 57275000
  else                                                                  57280000
    begin                                                               57285000
                                                                        57290000
      << Carriage control is not via the first byte of the >>           57295000
      << record, so set cctl false.                        >>           57300000
                                                                        57305000
      cctl := false;                                                    57310000
                                                                        57315000
    end;                                                                57320000
                                                                        57325000
                                                                        57330000
  << Now translate the function code into escape sequences, >>          57335000
  << if the translate flag passed in is true.               >>          57340000
                                                                        57345000
                                                                        57350000
  if translate'flag then                                                57355000
    begin                                                               57360000
                                                                        57365000
      return'information := cpr'xlate(cb'info(xlate'flags),             57370000
        seq'1'buff, seq'2'buff, function, parm1, parm2,                 57375000
        if cctl then byte'count-1 else byte'count,                      57380000
        @output'position.bit'15,                                        57385000
        (not expanded'features'flag));                                  57390000
                                                                        57395000
      << check error'parm from translation process >>                   57400000
      if error'parm <> no'errors then                                   57405000
        begin                                                           57410000
          return'status := error'parm;                                  57415000
          return;                                                       57420000
        end                                                             57425000
      else                                                              57430000
        begin                                                           57435000
        << The function was successfully translated.  Ex-    >>         57440000
        << tract the lengths of the sequence(s) from the re- >>         57445000
        << turn information.                                 >>         57450000
                                                                        57455000
          seq'1'count := sequence'counts.upper'byte;                    57460000
          seq'2'count := sequence'counts.lower'byte;                    57465000
        end;                                                            57470000
    end                                                                 57475000
  else                                                                  57480000
    begin                                                               57485000
      << No translation needed, so set the counts to zero. >>           57490000
                                                                        57495000
      seq'1'count := seq'2'count := 0;                                  57500000
    end;                                                                57505000
                                                                        57510000
                                                                        57515000
  << If there is a leading sequence, move it into the  >>               57520000
  << output record.                                    >>               57525000
                                                                        57530000
  if seq'1'count > 0 then                                               57535000
    begin                                                               57540000
      error'parm := move'internal'data(seq'1'buff,seq'1'count);         57545000
                                                                        57550000
      << check the error'parm >>                                        57555000
      if error'parm <> no'errors then                                   57560000
        begin                                                           57565000
          return'status := error'parm;                                  57570000
          return;                                                       57575000
        end;                                                            57580000
                                                                        57585000
    end;  << of if seq'1'count > 0 >>                                   57590000
                                                                        57595000
                                                                        57600000
                                                                        57605000
  << Now move the user's data (if any) into the record buf- >>          57610000
  << fer from the data segment specified by ATTACHIO.       >>          57615000
                                                                        57620000
                                                                        57625000
      while byte'count > 0 do                                           57630000
        begin                                                           57635000
          << there is some data to move.  Initialize cer- >>            57640000
          << tain flags                                   >>            57645000
                                                                        57650000
          << see what will fit into the current record >>               57655000
          if o'r'control(current'length) + byte'count >                 57660000
              o'r'control(maximum'size) then                            57665000
            begin                                                       57670000
              << It won't all fit, so determine what will >>            57675000
                                                                        57680000
              what'fits := o'r'control(maximum'size) -                  57685000
                  o'r'control(current'length);                          57690000
              if logical( what'fits.bit'15 ) then                       57695000
                begin                                                   57700000
                  << back off to an even number >>                      57705000
                  what'fits := what'fits - 1;                           57710000
                end;                                                    57715000
            end                                                         57720000
          else                                                          57725000
            begin                                                       57730000
              << it will all fit, so move it all >>                     57735000
                                                                        57740000
              what'fits := byte'count;                                  57745000
            end;                                                        57750000
                                                                        57755000
                                                                        57760000
        if what'fits > 0 then                                           57765000
          begin                                                         57770000
                                                                        57775000
          << reduce byte count by the amount that will be >>            57780000
          << moved from the data segment                  >>            57785000
          byte'count := byte'count - what'fits;                         57790000
                                                                        57795000
          << change byte count to word count for move >>                57800000
                                                                        57805000
              move'count := (what'fits + 1) to'word;                    57810000
                                                                        57815000
                                                                        57820000
          << now determine if the next position in the    >>            57825000
          << record buffer is on an odd or even byte      >>            57830000
          << boundary, and set up the appropriate address >>            57835000
          address'odd := logical( @output'position.bit'15 );            57840000
                                                                        57845000
          @next'word := (@output'position + 1) to'word;                 57850000
                                                                        57855000
                                                                        57860000
          << Move the user's data into the record buffer >>             57865000
                                                                        57870000
          mfds(next'word,dst'num,address,move'count);                   57875000
                                                                        57880000
          address := address + move'count;                              57885000
                                                                        57890000
          total'moved := total'moved + what'fits;                       57895000
                                                                        57900000
                                                                        57905000
                                                                        57910000
          << if starting address in buffer was odd, shuffle >>          57915000
          << the data up one byte.  In either case, update  >>          57920000
          << the buffer pointer.                            >>          57925000
                                                                        57930000
          if address'odd or cctl then                                   57935000
            begin                                                       57940000
              << One or two bytes will have to be compressed >>         57945000
              << out of the buffer.                          >>         57950000
                                                                        57955000
              offset := if address'odd then 1 else 0;                   57960000
              if cctl then                                              57965000
                begin                                                   57970000
                  offset := offset + 1;                                 57975000
                  what'fits := what'fits - 1;                           57980000
                  cctl := false;                                        57985000
                end;                                                    57990000
                                                                        57995000
              move output'position := output'position(offset),          58000000
                                      (what'fits),2;                    58005000
                                                                        58010000
              @output'position := tos;                                  58015000
                                                                        58020000
            end                                                         58025000
          else                                                          58030000
            begin                                                       58035000
              << don't move the data, just adjust pointers >>           58040000
                                                                        58045000
              @output'position := @output'position + what'fits;         58050000
            end;                                                        58055000
                                                                        58060000
          << update the record control information >>                   58065000
          o'r'control(current'position) := @output'position             58070000
              - @o'r'control to'byte;                                   58075000
          o'r'control(current'length) := o'r'control                    58080000
              (current'length) + what'fits;                             58085000
                                                                        58090000
          end;                                                          58095000
                                                                        58100000
                                                                        58105000
          << now determine if the record should be sent out >>          58110000
          << or if there is room for more data              >>          58115000
                                                                        58120000
          if o'r'control(current'length) >=                             58125000
             o'r'control(maximum'size) - 1 then                         58130000
            begin                                                       58135000
              << the record's full, so send it >>                       58140000
                                                                        58145000
              error'parm := send'then'build(output'data'type);          58150000
                                                                        58155000
              << check error'parm >>                                    58160000
              if error'parm <> no'errors then                           58165000
                begin                                                   58170000
                  return'status := error'parm;                          58175000
                  return;                                               58180000
                end;                                                    58185000
                                                                        58190000
            end;  << of send the record >>                              58195000
                                                                        58200000
        end;  << of while byte'count > 0 ... >>                         58205000
                                                                        58210000
                                                                        58215000
                                                                        58220000
  << Now buffer up the trailing escape sequence, if any >>              58225000
                                                                        58230000
  if seq'2'count > 0 then                                               58235000
    begin                                                               58240000
      << there is a trailing sequence, so move it into   >>             58245000
      << the buffer.                                     >>             58250000
                                                                        58255000
      error'parm := move'internal'data(seq'2'buff,seq'2'count);         58260000
                                                                        58265000
      << check error'parm >>                                            58270000
      if error'parm <> no'errors then                                   58275000
        begin                                                           58280000
          return'status := error'parm;                                  58285000
          return;                                                       58290000
        end;                                                            58295000
                                                                        58300000
                                                                        58305000
    end;  << of move trailing sequence, if any >>                       58310000
                                                                        58315000
                                                                        58320000
  << If we get here, there have been no errors that could >>            58325000
  << not be recovered, so return a good completion code   >>            58330000
  << to the caller.                                       >>            58335000
                                                                        58340000
  return'status := no'errors;                                           58345000
                                                                        58350000
  transfer'log := if count < 0 then -total'moved                        58355000
                               else total'moved to'word;                58360000
                                                                        58365000
                                                                        58370000
end;  << of write'data procedure >>                                     58375000
                                                                        58380000
$PAGE "PROCEDURE:  B08'CONFIGURE"                                       58385000
integer procedure b08'configure(cb'info, sr'enable,                     58390000
                                esb'frequency        );                 58395000
                                                                        58400000
  value                         cb'info, sr'enable,                     58405000
                                esb'frequency         ;                 58410000
                                                                        58415000
  integer pointer               cb'info               ;                 58420000
                                                                        58425000
  integer                                sr'enable,                     58430000
                                esb'frequency         ;                 58435000
                                                                        58440000
  option privileged, uncallable                       ;                 58445000
                                                                        58450000
                                                                        58455000
COMMENT                                                                 58460000
                                                                        58465000
  PURPOSE:                                                              58470000
                                                                        58475000
    This procedure will build and send a configuration record           58480000
    to the peripheral.  For the 2608B, this record contains             58485000
    information controlling unsolicited status reports and              58490000
    frequency of environmental status reporting.                        58495000
                                                                        58500000
                                                                        58505000
  INPUT PARAMETERS:                                                     58510000
                                                                        58515000
    CB'INFO, which is a pointer to the control block information        58520000
      area for the logical driver of this ldev.                         58525000
                                                                        58530000
    SR'ENABLE, which allows the peripheral to send unsolicited          58535000
      status reports, if the least significant bit is set.              58540000
      Otherwise, the only unsolicited report that can be sent           58545000
      is the powerfail report.                                          58550000
                                                                        58555000
    ESB'FREQUENCY, which specifies the number of checkpoint             58560000
      occurances between reported environmental status'.  If            58565000
      set to zero, no environmental status reports will be sent         58570000
      unless specifically commanded to do so.                           58575000
                                                                        58580000
                                                                        58585000
  OUTPUT PARAMETERS:                                                    58590000
                                                                        58595000
    B08'CONFIGURE, which is the completion status of the                58600000
      procedure call.  A value of one is returned if no errors          58605000
      occurred.  Other values will be defined as required.              58610000
                                                                        58615000
                                                                        58620000
  SIDE-EFFECTS:                                                         58625000
                                                                        58630000
    None.                                                               58635000
                                                                        58640000
                                                                        58645000
  SPECIAL CONSIDERATIONS:                                               58650000
                                                                        58655000
    When called, DB must be set to the base of the CIPER data           58660000
    segment.                                                            58665000
                                                                        58670000
                                                                        58675000
  CHANGE HISTORY:                                                       58680000
                                                                        58685000
    As issued.                                                          58690000
                                                                        58695000
                                                                        58700000
;                                                                       58705000
$PAGE "PROCEDURE:  B08'CONFIGURE -- LOCAL DECLARATIONS"                 58710000
begin                                                                   58715000
                                                                        58720000
  define                                                                58725000
                                                                        58730000
    upper'byte                    = (0:8) #                             58735000
   ,lower'byte                    = (8:8) #                             58740000
                                                                        58745000
  ;                                                                     58750000
                                                                        58755000
                                                                        58760000
  integer pointer                                                       58765000
                                                                        58770000
    o'r'control                                                         58775000
      << points to control information for output record >>             58780000
                                                                        58785000
   ,o'r'data                                                            58790000
      << points to data portion of output record buffer area >>         58795000
                                                                        58800000
  ;                                                                     58805000
                                                                        58810000
  integer                                                               58815000
                                                                        58820000
    return'status                 = b08'configure                       58825000
      << completion status for procedure call >>                        58830000
                                                                        58835000
  ;                                                                     58840000
                                                                        58845000
$PAGE "PROCEDURE:  B08'CONFIGURE -- PROCEDURE BODY"                     58850000
  << First, initialize the output record pointers. >>                   58855000
                                                                        58860000
  @o'r'control := b08'get'buffer(cb'info, output'overwrite);            58865000
                                                                        58870000
  @o'r'data := @o'r'control + o'r'control(start);                       58875000
                                                                        58880000
                                                                        58885000
  << Build the configuration record >>                                  58890000
                                                                        58895000
  b08'build'header( o'r'control,                                        58900000
                    lgl'configuration,                                  58905000
                    status'mask,                               <<04422>>58910000
                    set'bit, << sob'flag >>                    <<04422>>58915000
                    set'bit  << eob'flag >> );                 <<04422>>58920000
                                                                        58925000
                                                                        58930000
O'R'DATA(PARM'BYTE'1) := SR'ENABLE.BIT'15;                     <<07425>>58935000
  o'r'data(parm'byte'2) := esb'frequency.upper'byte;                    58940000
  o'r'data(parm'byte'3) := esb'frequency.lower'byte;                    58945000
                                                                        58950000
  o'r'control(current'length) :=                                        58955000
      o'r'control(current'length) + 3;                                  58960000
                                                                        58965000
                                                                        58970000
  << Send the record to the peripheral >>                               58975000
                                                                        58980000
  return'status := cpr'send'record(cb'info, o'r'control);               58985000
                                                                        58990000
                                                                        58995000
  << Release the allocated buffer. >>                                   59000000
                                                                        59005000
  b08'release'buffer(cb'info, o'r'control);                             59010000
                                                                        59015000
                                                                        59020000
end;  << of procedure b08'configure >>                                  59025000
                                                                        59030000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR"                                    59035000
integer procedure b08'device'clear(cb'info, dev'clear'parm);            59040000
                                                                        59045000
  value                            cb'info, dev'clear'parm ;            59050000
                                                                        59055000
  integer pointer                  cb'info                 ;            59060000
                                                                        59065000
  integer                                   dev'clear'parm ;            59070000
                                                                        59075000
  option privileged, uncallable                            ;            59080000
                                                                        59085000
                                                                        59090000
COMMENT                                                                 59095000
                                                                        59100000
  PURPOSE:                                                              59105000
                                                                        59110000
    This procedure will issue a DEVICE CLEAR command to the             59115000
    peripheral.  It then waits for the peripheral to return a           59120000
    CLEAR RESPONSE, at which point the send and receive record          59125000
    counts are cleared (set to zero).  If other information is          59130000
    returned before the CLEAR RESPONSE, this procedure will             59135000
    determine if that information should be processed or ig-            59140000
    nored.                                                              59145000
                                                                        59150000
                                                                        59155000
  INPUT PARAMETERS:                                                     59160000
                                                                        59165000
    CB'INFO, which is a pointer to the base of the control              59170000
      block level dependent information area (used for global           59175000
      storage by the logical driver).                                   59180000
                                                                        59185000
    DEV'CLEAR'PARM, which will become the parameter byte of             59190000
      the DEVICE CLEAR command.  This parameter determines              59195000
      what information in the device will be cleared and what           59200000
      will remain intact.  Only the least significant bit               59205000
      meaning, the others should be set to zero.                        59210000
                                                                        59215000
                                                                        59220000
  OUTPUT PARAMETERS:                                                    59225000
                                                                        59230000
    B08'DEVICE'CLEAR, which returns the completion status of            59235000
      the call.  If no errors occured, a value of one is re-            59240000
      turned.  Other values will be defined as required.                59245000
                                                                        59250000
                                                                        59255000
  SIDE EFFECTS:                                                         59260000
                                                                        59265000
    This procedure will initialize several variables located in         59270000
    the control block information area, most notably the input          59275000
    and output receive ready counters.  In addition, the device         59280000
    status area may be updated if any device status reports are         59285000
    received while waiting for the CLEAR RESPONSE report.               59290000
                                                                        59295000
                                                                        59300000
  SPECIAL CONSIDERATIONS:                                               59305000
                                                                        59310000
    Before calling the procedure, the caller must have DB set           59315000
    data segment.  Any pending output records will                      59320000
    be overwritten when this procedure creates its device clear         59325000
    command.                                                            59330000
                                                                        59335000
                                                                        59340000
  CHANGE HISTORY:                                                       59345000
                                                                        59350000
    8/31/83  Satish Janardan, Chuck Mayne                      <<07425>>59355000
                                                               <<07425>>59360000
    Removed the recursive nature of b08'device'clear, so that  <<07425>>59365000
    a greater number of device clears could be performed with- <<07425>>59370000
    out stack overflow problems.                               <<07425>>59375000
                                                               <<07425>>59380000
    Added logging of calls to b08'device'clear.                <<07425>>59385000
                                                                        59390000
                                                                        59395000
;                                                                       59400000
                                                                        59405000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR -- LOCAL VARIABLES"                 59410000
begin                                                                   59415000
  << DECLARATION OF LOCAL VARIABLES >>                                  59420000
                                                                        59425000
  integer pointer                                                       59430000
                                                                        59435000
    i'o'control                                                         59440000
      << points to input record control area >>                         59445000
                                                                        59450000
   ,i'o'record                                                          59455000
      << points to base of output record area >>                        59460000
                                                                        59465000
  ;                                                                     59470000
                                                                        59475000
  byte pointer                                                          59480000
                                                                        59485000
    destination                                                         59490000
      << temporary destination address for moving bytes out >>          59495000
      << of the Clear Response fields into the control block >>         59500000
      << information area.                                   >>         59505000
                                                                        59510000
   ,input'position                                                      59515000
      << byte pointer into the input record buffer area.    >>          59520000
      << Used for moving bytes out of various fields of the >>          59525000
      << Clear Response.                                    >>          59530000
                                                                        59535000
  ;                                                                     59540000
                                                                        59545000
  integer                                                               59550000
                                                                        59555000
    seq'number'sent                                                     59560000
      << contains the sequence number sent in the device >>             59565000
      << clear record.  This number should be returned in >>            59570000
      << the peripheral's clear response.                >>             59575000
                                                                        59580000
   ,error'parm                                                          59585000
      << Used for completion status from other procedures >>            59590000
                                                                        59595000
   ,stat'error                                                          59600000
      << Used to hold status error returns during evaluation >>         59605000
                                                               <<07425>>59610000
   ,device'clear'count                                         <<07425>>59615000
      << Counts how many device clears have been attempted >>  <<07425>>59620000
      << during this call.  If the count exceeds a pre-    >>  <<07425>>59625000
      << defined maximum, the process terminates with a    >>  <<07425>>59630000
      << fatal error.                                      >>  <<07425>>59635000
                                                               <<07425>>59640000
   ,return'status                 = b08'device'clear           <<07425>>59645000
      << Use function return space for return'status >>        <<07425>>59650000
                                                                        59655000
  ;                                                                     59660000
                                                                        59665000
  equate                                                                59670000
                                                                        59675000
    dev'clear'length              = 1                                   59680000
      << length of device clear parameter field(s) >>                   59685000
                                                                        59690000
  ;                                                                     59695000
                                                                        59700000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>59705000
                                                               <<07425>>59710000
  integer pointer                                              <<07425>>59715000
                                                               <<07425>>59720000
    log'buffer                                                 <<07425>>59725000
      << points to logging buffer of cbix >>                   <<07425>>59730000
                                                               <<07425>>59735000
  ;                                                            <<07425>>59740000
                                                               <<07425>>59745000
                                                               <<07425>>59750000
  declare'move'to'data'segment;                                <<07425>>59755000
                                                               <<07425>>59760000
  declare'get'log'buffer;                                      <<07425>>59765000
                                                               <<07425>>59770000
  declare'put'le;                                              <<07425>>59775000
                                                               <<07425>>59780000
  declare'event'enabled;                                       <<07425>>59785000
                                                               <<07425>>59790000
$IF                                                            <<07425>>59795000
                                                               <<07425>>59800000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR -- SUBROUTINE:  RETURN'BUFFERS"     59805000
subroutine return'buffers;                                              59810000
                                                                        59815000
COMMENT                                                                 59820000
                                                                        59825000
  PURPOSE:                                                              59830000
    This subroutine will return the input and output buffers            59835000
    to the free-list, if they came from there.  If the normal           59840000
    i/o buffer(s) had to be overwritten to accomplish the               59845000
    device clear, they will merely be marked free.                      59850000
                                                                        59855000
;                                                                       59860000
                                                                        59865000
begin                                                                   59870000
                                                                        59875000
  b08'release'buffer(cb'info, i'o'control);                             59880000
                                                                        59885000
  cb'info(dev'clr'in'progress) := false;                       <<07425>>59890000
end;  << of subroutine return'buffers >>                                59895000
$PAGE "PROCEDURE: B08'DEVICE'CLEAR --",&                       <<07425>>59900000
$     "SUBROUTINE: SEND'DEVICE'CLEAR"                          <<07425>>59905000
subroutine send'device'clear;                                  <<07425>>59910000
                                                               <<07425>>59915000
COMMENT                                                        <<07425>>59920000
                                                               <<07425>>59925000
  PURPOSE:                                                     <<07425>>59930000
     Build a DEVICE CLEAR record, such that the device will    <<07425>>59935000
     clear all input and output buffers, abort all pending     <<07425>>59940000
     reads, and clear all programmable features.               <<07425>>59945000
                                                               <<07425>>59950000
;                                                              <<07425>>59955000
                                                               <<07425>>59960000
begin                                                          <<07425>>59965000
                                                               <<07425>>59970000
  b08'build'header( i'o'control,                               <<07425>>59975000
                    lgl'device'clear,                          <<07425>>59980000
                    , << no data'type used >>                  <<07425>>59985000
                    set'bit, << sob'flag >>                    <<07425>>59990000
                    set'bit  << eob'flag >>    );              <<07425>>59995000
                                                               <<07425>>60000000
  i'o'record(parm'byte'1) := dev'clear'parm.bit'15;            <<07425>>60005000
                                                               <<07425>>60010000
  i'o'control(current'length) :=                               <<07425>>60015000
      i'o'control(current'length) + dev'clear'length;          <<07425>>60020000
                                                               <<07425>>60025000
  << Save the sequence number sent to the peripheral.  It >>   <<07425>>60030000
  << should return that value in the CLEAR RESPONSE as an >>   <<07425>>60035000
  << error checking mechanism.                            >>   <<07425>>60040000
                                                               <<07425>>60045000
  seq'number'sent := cb'info(output'sequence'count);           <<07425>>60050000
                                                               <<07425>>60055000
  << Send the record to the peripheral.  Set the 'force'  >>   <<07425>>60060000
  << mode so normal protocol will be overridden for this >>    <<07425>>60065000
  << transfer.                                            >>   <<07425>>60070000
                                                               <<07425>>60075000
  error'parm := cpr'force'record(cb'info,i'o'control);         <<07425>>60080000
                                                               <<07425>>60085000
end;                                                           <<07425>>60090000
$PAGE "PROCEDURE: b08'DEVICE'CLEAR"                            <<07425>>60095000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>60100000
                                                               <<07425>>60105000
if event'enabled(le'device'clear) then                         <<07425>>60110000
  begin                                                        <<07425>>60115000
    @log'buffer := get'log'buffer(log'buffer);                 <<07425>>60120000
    log'buffer(log'entry'type) := le'device'clear;             <<07425>>60125000
    log'buffer(log'entry'data) :=                              <<07425>>60130000
      cb'info(dev'clr'count);                                  <<07425>>60135000
    log'buffer(log'entry'data+1) :=                            <<07425>>60140000
      cb'info(output'sequence'count);                          <<07425>>60145000
    put'le( log'buffer, 2 );                                   <<07425>>60150000
  end;                                                         <<07425>>60155000
                                                               <<07425>>60160000
$IF                                                            <<07425>>60165000
                                                               <<07425>>60170000
                                                               <<07425>>60175000
  << Assume successful completion >>                           <<07425>>60180000
                                                               <<07425>>60185000
  return'status := successful;                                 <<07425>>60190000
                                                               <<07425>>60195000
                                                               <<07425>>60200000
  << Check for recursion.  Return if this is the second >>     <<07425>>60205000
  << entry to device'clear.  Recovery will be performed >>     <<07425>>60210000
  << by first invocation of device'clear.               >>     <<07425>>60215000
                                                               <<07425>>60220000
  if cb'info(dev'clr'count) = 1 then                           <<07425>>60225000
    begin                                                      <<07425>>60230000
      return;                                                  <<07425>>60235000
    end;                                                       <<07425>>60240000
                                                               <<07425>>60245000
                                                               <<07425>>60250000
  retry:                                                       <<07425>>60255000
                                                               <<07425>>60260000
                                                               <<07425>>60265000
  << Indicate this the first device clear to be sent. >>       <<07425>>60270000
                                                               <<07425>>60275000
  device'clear'count := 1;                                     <<07425>>60280000
                                                               <<07425>>60285000
  << Mark true the device clear in progress indicator.   >>    <<07425>>60290000
                                                               <<07425>>60295000
  cb'info(dev'clr'in'progress) := true;                        <<07425>>60300000
                                                               <<07425>>60305000
                                                               <<07425>>60310000
  << Set up pointers to output record buffer area >>           <<07425>>60315000
                                                               <<07425>>60320000
  @i'o'control := b08'get'buffer(cb'info, output'overwrite);   <<07425>>60325000
                                                               <<07425>>60330000
  @i'o'record := i'o'control(start) + @i'o'control;            <<07425>>60335000
  send'device'clear;                                           <<07425>>60340000
                                                               <<07425>>60345000
  << check the error'parm >>                                   <<07425>>60350000
  if error'parm = no'errors then                               <<07425>>60355000
    begin                                                      <<07425>>60360000
      << Clear command was successfully sent.  Now wait for >> <<07425>>60365000
      << peripheral to respond with the Clear Response.  If >> <<07425>>60370000
      << anything else comes in, ignore it.                 >> <<07425>>60375000
                                                               <<07425>>60380000
                                                               <<07425>>60385000
      do                                                       <<07425>>60390000
        begin                                                  <<07425>>60395000
          << Loop until the correct response is received. >>   <<07425>>60400000
          << First set the input record inactive. >>           <<07425>>60405000
                                                               <<07425>>60410000
get'clear'response:                                            <<07425>>60415000
          i'o'control(active) := free;                         <<07425>>60420000
                                                               <<07425>>60425000
          << Now get a record from the transport service >>    <<07425>>60430000
                                                               <<07425>>60435000
          error'parm := cpr'get'record(cb'info,i'o'control,    <<07425>>60440000
                                       dont'care);             <<07425>>60445000
                                                               <<07425>>60450000
          << check the error'parm >>                           <<07425>>60455000
          if error'parm = no'errors then                       <<07425>>60460000
            begin                                              <<07425>>60465000
              << Something came in without transport >>        <<07425>>60470000
              << errors. If it is device status then >>        <<07425>>60475000
              << process it, else ignore the status  >>        <<07425>>60480000
                                                               <<07425>>60485000
              if i'o'record(header'opcode) <>                  <<07425>>60490000
                  lgl'clear'response then                      <<07425>>60495000
                begin                                          <<07425>>60500000
                  if i'o'record(header'opcode) =               <<07425>>60505000
                      lgl'status'report then                   <<07425>>60510000
                    begin                                      <<07425>>60515000
                      stat'error := b08'process'status(        <<07425>>60520000
                                       cb'info, i'o'control);  <<07425>>60525000
                                                               <<07425>>60530000
                      return'status := b08'worst'status(       <<07425>>60535000
                                         stat'error,           <<07425>>60540000
                                         return'status );      <<07425>>60545000
                                                               <<07425>>60550000
                      << The status requires a device clear,>> <<07425>>60555000
                      << so send down a device clear.       >> <<07425>>60560000
                                                               <<07425>>60565000
                      if stat'error = pf'error or              <<07425>>60570000
                         stat'error = error'so'read'status     <<07425>>60575000
                        then begin                             <<07425>>60580000
                        << If we are attempting to do more  >> <<07425>>60585000
                        << than fifty device clears, there  >> <<07425>>60590000
                        << is obviously something wrong.    >> <<07425>>60595000
                        << Give up and return a catastrophic>> <<07425>>60600000
                        << error.                           >> <<07425>>60605000
                                                               <<07425>>60610000
retry2:                                                        <<07425>>60615000
                        if device'clear'count = 50 then        <<07425>>60620000
                          begin                                <<07425>>60625000
                                                               <<07425>>60630000
                            b08'device'clear := fatal'error;   <<07425>>60635000
                            return'buffers;                    <<07425>>60640000
                            return;                            <<07425>>60645000
                                                               <<07425>>60650000
                          end;                                 <<07425>>60655000
                                                               <<07425>>60660000
                        << Increment the count of device    >> <<07425>>60665000
                        << clear.                           >> <<07425>>60670000
                                                               <<07425>>60675000
                        device'clear'count :=                  <<07425>>60680000
                                  device'clear'count + 1;      <<07425>>60685000
                                                               <<07425>>60690000
                        send'device'clear;                     <<07425>>60695000
                                                               <<07425>>60700000
                        if error'parm <> no'error then         <<07425>>60705000
                          begin                                <<07425>>60710000
                            << Transport service error     >>  <<07425>>60715000
                            << occured.  Return error.     >>  <<07425>>60720000
                                                               <<07425>>60725000
                            return'buffers;                    <<07425>>60730000
                            b08'device'clear := error'parm;    <<07425>>60735000
                            return;                            <<07425>>60740000
                          end                                  <<07425>>60745000
                        else                                   <<07425>>60750000
                          begin                                <<07425>>60755000
                            go get'clear'response;             <<07425>>60760000
                          end;                                 <<07425>>60765000
                        end;                                   <<07425>>60770000
                    end;                                       <<07425>>60775000
                end;                                           <<07425>>60780000
            end                                                <<07425>>60785000
          else                                                 <<07425>>60790000
            begin                                              <<07425>>60795000
              << A transport serivce error occurred. >>        <<07425>>60800000
              << Return with an error.               >>        <<07425>>60805000
                                                               <<07425>>60810000
              return'buffers;                                  <<07425>>60815000
              return'status :=                                 <<07425>>60820000
                  b08'worst'status(return'status,error'parm);  <<07425>>60825000
              if error'parm = wrong'creator then go retry2;    <<07425>>60830000
              return;                                          <<07425>>60835000
            end;                                               <<07425>>60840000
        end                                                    <<07425>>60845000
      until i'o'record(header'opcode) = lgl'clear'response     <<07425>>60850000
        and i'o'record(parm'byte'1) = seq'number'sent;         <<07425>>60855000
                                                                        60860000
      << Now that we have the Clear Response desired, update >>         60865000
      << the appropriate information in the control block    >>         60870000
      << information area.                                   >>         60875000
                                                                        60880000
      cb'info(output'sequence'count) := 0;                              60885000
      cb'info(input'sequence'count) := 1;                               60890000
      cb'info(receive'ready'count) := 0;                                60895000
                                                                        60900000
      cb'info(dev'clr'in'progress) := false;                            60905000
                                                                        60910000
                                                                        60915000
      << Extract the information from the clear responce >>             60920000
                                                                        60925000
      @input'position := ( @i'o'record to'byte )                        60930000
          + rec'head'length + 1;                                        60935000
                                                                        60940000
      if i'o'control(current'length) >= 12 then                         60945000
        begin                                                           60950000
          @destination := ( cb'info(product'number)                     60955000
                          + cb'info(cds'area'base) ) to'byte;           60960000
          move destination :=                                           60965000
               input'position,(product'id'length),1;                    60970000
          @input'position := tos;  del;                                 60975000
        end;                                                            60980000
                                                                        60985000
      if i'o'control(current'length) >= 14 then                         60990000
        begin                                                           60995000
                                                                        61000000
                                                                        61005000
          @destination := @cb'info(device'buffer'size) to'byte;         61010000
          move destination := input'position,(2),1;                     61015000
          @input'position := tos;  del;                                 61020000
                                                                        61025000
          << Multiply the buffer size by 128 (Device reports >>         61030000
          << size/128                                        >>         61035000
                                                                        61040000
          cb'info(device'buffer'size) :=                                61045000
           (  cb'info(device'buffer'size) & lsl(4) );                   61050000
        end;                                                            61055000
                                                                        61060000
      if i'o'control(current'length) >= 16 then                         61065000
        begin                                                           61070000
          << Move the environmental status size >>                      61075000
                                                                        61080000
          @destination := @cb'info(device'env'status'size)&lsl(1);      61085000
          move destination := input'position,(2);                       61090000
        end                                                             61095000
      else                                                              61100000
        begin                                                           61105000
          << Did not get environmental status size, so >>               61110000
          << set a default size of 32.                 >>               61115000
                                                                        61120000
          cb'info(device'env'status'size) := 32;                        61125000
        end;                                                            61130000
                                                                        61135000
                                                                        61140000
      << Mark the input record as available >>                          61145000
                                                                        61150000
      return'buffers;                                                   61155000
                                                                        61160000
      << Attempting to set the configuration might cause a >>  <<07425>>61165000
      << recursion of this procedure.  Set a flag to indi- >>  <<07425>>61170000
      << cate such action.                                 >>  <<07425>>61175000
                                                               <<07425>>61180000
      cb'info(dev'clr'count) := 1;                             <<07425>>61185000
                                                               <<07425>>61190000
                                                               <<07425>>61195000
                                                                        61200000
      << Now send the peripheral configuration command to >>            61205000
      << establish status reporting and set the requested >>            61210000
      << environmental status reporting frequency.        >>            61215000
                                                                        61220000
      error'parm := b08'configure( cb'info                              61225000
                                  ,true  << sr'enable >>                61230000
                                  ,cb'info(esb'frequency) );            61235000
                                                                        61240000
      return'status := b08'worst'status( error'parm            <<07425>>61245000
                                        ,return'status );      <<07425>>61250000
                                                               <<07425>>61255000
      cb'info(dev'clr'count) := 0;                             <<07425>>61260000
                                                               <<07425>>61265000
      if error'parm <> successful then                         <<07425>>61270000
        begin                                                  <<07425>>61275000
          if error'parm = pf'error                             <<07425>>61280000
          or error'parm = record'sequence'error                <<07425>>61285000
          or error'parm = error'so'read'status then            <<07425>>61290000
            go retry;                                          <<07425>>61295000
        end;                                                   <<07425>>61300000
                                                                        61305000
                                                                        61310000
                                                                        61315000
    end                                                                 61320000
  else                                                                  61325000
    begin                                                               61330000
      << Device Clear command could not be sent to the de-   >>         61335000
      << vice.  Free up both buffers and return to the       >>         61340000
      << caller with an error.                               >>         61345000
                                                                        61350000
      return'buffers;                                                   61355000
      b08'device'clear := error'parm;                                   61360000
    end;                                                                61365000
                                                                        61370000
                                                                        61375000
                                                                        61380000
end;  << of b08'device'clear >>                                         61385000
                                                                        61390000
$PAGE "PROCEDURE:  B08'RETURN'JOB'REPORT"                               61395000
double procedure B08'return'job'report(cb'info, dst'num,                61400000
                                       address, count,                  61405000
                                       new'status'flag   );             61410000
                                                                        61415000
  value                                cb'info, dst'num,                61420000
                                       address, count,                  61425000
                                       new'status'flag    ;             61430000
                                                                        61435000
  integer pointer                      cb'info            ;             61440000
                                                                        61445000
  integer                                    dst'num,                   61450000
                                       address, count     ;             61455000
                                                                        61460000
  logical                              new'status'flag    ;             61465000
                                                                        61470000
  option privileged, uncallable                           ;             61475000
                                                                        61480000
                                                                        61485000
                                                                        61490000
                                                                        61495000
COMMENT                                                                 61500000
                                                                        61505000
  PURPOSE:                                                              61510000
    This procedure will return the job report information               61515000
    buffered in the CIPER data segment to the caller.  The              61520000
    caller must specify the data segment number and offset of           61525000
    the destination buffer, as well as the buffer size.                 61530000
                                                                        61535000
                                                                        61540000
  INPUT PARAMETERS:                                                     61545000
                                                                        61550000
    CB'INFO, a pointer to the control block information area            61555000
      for this ldev's level 7.                                          61560000
                                                                        61565000
    DST'NUM, which is the data segment number where the caller          61570000
      would like the status information moved.                          61575000
                                                                        61580000
    ADDRESS, which is the offset within the specified data              61585000
      segment where the data is to be moved.                            61590000
                                                                        61595000
    COUNT, which is the maximum amount of data the caller               61600000
      wishes moved.  If positive, the count specifies words.            61605000
      If negative, the count specifies bytes.                           61610000
                                                                        61615000
    NEW'STATUS'FLAG, which if false indicates that any status           61620000
      currently in the job report status area should be moved.          61625000
      If true, then a new copy of the job report status should          61630000
      be requested from the device.                                     61635000
                                                                        61640000
                                                                        61645000
                                                                        61650000
  OUTPUT PARAMETERS:                                                    61655000
                                                                        61660000
    B08'RETURN'JOB'REPORT, which is a double word function re-          61665000
      turn.  The most significant word is the completion sta-           61670000
      tus for the call.  The least significant word is the              61675000
      transfer count of data actually moved (maintains the same         61680000
      sense (+/-) as the input parameter COUNT).                        61685000
                                                                        61690000
  SIDE-EFFECTS:                                                         61695000
                                                                        61700000
    None.                                                               61705000
                                                                        61710000
                                                                        61715000
  SPECIAL CONSIDERATIONS:                                               61720000
                                                                        61725000
    When called, this procedure assumes DB is pointing to the           61730000
    base of the appropriate CIPER data segment.                         61735000
                                                                        61740000
                                                                        61745000
  CHANGE HISTORY:                                                       61750000
                                                                        61755000
    As issued.                                                          61760000
                                                                        61765000
                                                                        61770000
;                                                                       61775000
$PAGE "PROCEDURE:  B08'RETURN'JOB'REPORT -- LOCAL VARIABLES"            61780000
                                                                        61785000
begin                                                                   61790000
                                                                        61795000
  << Declaration of local variables >>                                  61800000
                                                                        61805000
  integer pointer                                                       61810000
                                                                        61815000
    status'information                                                  61820000
      << points to data in status tank of CIPER dst >>                  61825000
                                                                        61830000
  ;                                                                     61835000
                                                                        61840000
                                                                        61845000
  logical                                                               61850000
                                                                        61855000
    count'was'negative                                                  61860000
      << flag to indicate need to convert transfer'log back >>          61865000
      << to bytes                                           >>          61870000
                                                                        61875000
  ;                                                                     61880000
                                                                        61885000
                                                                        61890000
  integer                                                               61895000
                                                                        61900000
    return'status                 = b08'return'job'report               61905000
      << completion status of procedure >>                              61910000
                                                                        61915000
   ,transfer'log                  = b08'return'job'report + 1           61920000
      << number of bytes/words returned to user >>                      61925000
                                                                        61930000
  ;                                                                     61935000
                                                                        61940000
                                                                        61945000
  integer pointer                                                       61950000
                                                                        61955000
    i'o'control                                                         61960000
      << Points to record buffer area used to request/re-  >>           61965000
      << ceive job report status if a new copy has been    >>           61970000
      << requested by the caller.                          >>           61975000
                                                                        61980000
  ;                                                                     61985000
                                                                        61990000
  declare'move'to'data'segment;                                         61995000
$PAGE "PROCEDURE:  B08'RETURN'JOB'REPORT -- PROCEDURE BODY"             62000000
  << If the caller requested a new copy of the job report,  >>          62005000
  << we should first send any pending data, so the job re-  >>          62010000
  << port will accurately reflect the number of pages the   >>          62015000
  << job has so far printed.                                >>          62020000
                                                                        62025000
  if new'status'flag then                                               62030000
    begin                                                               62035000
                                                                        62040000
      @i'o'control := cb'info(o'r'base)                                 62045000
                    + cb'info(cds'area'base);                           62050000
      if logical( i'o'control(active) ) then                            62055000
        begin                                                           62060000
          return'status := cpr'send'record( cb'info,                    62065000
                                            i'o'control );              62070000
          if return'status.general <> successful then                   62075000
            begin                                                       62080000
              return;                                                   62085000
            end;                                                        62090000
        end;                                                            62095000
                                                                        62100000
      b08'build'header( i'o'control,                                    62105000
                        lgl'report'job'status,                          62110000
                        , << no data'type used >>              <<04422>>62115000
                        set'bit, << sob'flag >>                <<04422>>62120000
                        set'bit  << eob'flag >>   );           <<04422>>62125000
                                                                        62130000
      return'status := cpr'send'record( cb'info,                        62135000
                                        i'o'control );                  62140000
                                                                        62145000
      if return'status.general <> successful then                       62150000
        begin                                                           62155000
          return;                                                       62160000
        end;                                                            62165000
                                                                        62170000
      return'status := cpr'get'record( cb'info,                         62175000
                                       i'o'control,                     62180000
                                       lgl'job'report );                62185000
                                                                        62190000
      if return'status.general <> successful then                       62195000
        begin                                                           62200000
          return;                                                       62205000
        end;                                                            62210000
                                                                        62215000
      b08'job'report( cb'info, i'o'control );                           62220000
                                                                        62225000
    end;  << of if new'status'flag >>                                   62230000
                                                                        62235000
                                                                        62240000
  << Initialize the status pointer >>                                   62245000
                                                                        62250000
  @status'information := cb'info(job'report'base)                       62255000
                       + cb'info(cds'area'base);                        62260000
                                                                        62265000
                                                                        62270000
  << Determine if requested count is greater than the length >>         62275000
  << of the status information.  If it is, move all of the   >>         62280000
  << status. If not, only move part of it.  Only an even     >>         62285000
  << number of bytes may be moved across the dst boundary.   >>         62290000
                                                                        62295000
  << First, we must make sure the requested count is words >>           62300000
                                                                        62305000
  if count < 0 then                                                     62310000
    begin                                                               62315000
      count := (-count) to'word;                                        62320000
      count'was'negative := true;                                       62325000
    end                                                                 62330000
  else                                                                  62335000
    begin                                                               62340000
      count'was'negative := false;                                      62345000
    end;                                                                62350000
                                                                        62355000
  << Determine which is larger, the requested count or the >>           62360000
  << status information.                                   >>           62365000
                                                                        62370000
  if count > (job'report'length to'word) then                           62375000
    begin                                                               62380000
      count := job'report'length to'word;                               62385000
    end;                                                                62390000
                                                                        62395000
  << Move the information to the caller's dst. >>                       62400000
                                                                        62405000
  if count > 0 then                                            <<04434>>62410000
    begin                                                      <<04434>>62415000
      mtds(dst'num,address,status'information,count);          <<04434>>62420000
    end;                                                       <<04434>>62425000
                                                                        62430000
  << Now adjust the return count information. >>                        62435000
                                                                        62440000
  if  count'was'negative then                                           62445000
    begin                                                               62450000
      transfer'log := -(count to'byte);                                 62455000
    end                                                                 62460000
  else                                                                  62465000
    begin                                                               62470000
      transfer'log := count;                                            62475000
    end;                                                                62480000
                                                                        62485000
  << Set up the error return >>                                         62490000
                                                                        62495000
  return'status := no'errors;                                           62500000
                                                                        62505000
end;  << of procedure b08'return'job'report >>                          62510000
                                                                        62515000
$PAGE "B08'END'JOB"                                                     62520000
double procedure b08'end'job( cb'info, dst'num, address,                62525000
                              count, flags              );              62530000
                                                                        62535000
  value                       cb'info, dst'num, address,                62540000
                              count, flags               ;              62545000
                                                                        62550000
  integer pointer             cb'info                    ;              62555000
                                                                        62560000
  integer                              dst'num, address,                62565000
                              count, flags               ;              62570000
                                                                        62575000
  option privileged, uncallable                          ;              62580000
                                                                        62585000
                                                                        62590000
COMMENT                                                                 62595000
                                                                        62600000
  PURPOSE:                                                              62605000
                                                                        62610000
    This procedure will send the END OF JOB command to the              62615000
    peripheral, then clean up and job related information in            62620000
    the control block information area.  If any output record           62625000
    buffers were pending transmission, they will be sent to             62630000
    the peripheral before the job end command is sent.                  62635000
                                                                        62640000
    Additionally, if the caller has specified a destination             62645000
    buffer, the contents of the job report record, if any is            62650000
    received from the peripheral, will be moved to that buffer.         62655000
                                                                        62660000
                                                                        62665000
  INPUT PARAMETERS:                                                     62670000
                                                                        62675000
    CB'INFO, which points to the control block information area         62680000
      of the logical driver.                                            62685000
                                                                        62690000
                                                                        62695000
    DST'NUM, which is the index of a data segment the caller            62700000
      has provided a data buffer in for reception of the job            62705000
      report information.  It will be non-zero for a dst index,         62710000
      but could be passed as zero if system buffers are spe-            62715000
      cified, or the job report information is not desired.             62720000
                                                                        62725000
    ADDRESS, which, depending on the system buffer bit of FLAGS         62730000
      will be either an offset to the data segment specified by         62735000
      DST'NUM, or the sysdb relative index of a system buffer.          62740000
                                                                        62745000
    COUNT, which specifies the maximum amount of job report             62750000
      information to return to the specified buffer.  If the            62755000
      count is zero, no information is returned.  If positive,          62760000
      the request is in words.  If negative, the request is in          62765000
      bytes.                                                            62770000
                                                                        62775000
    FLAGS, which contain the system buffer flag (12:1) that             62780000
      indicates whether ADDRESS is a system buffer index (set)          62785000
      or an offset to a data segment (clear).                           62790000
                                                                        62795000
                                                                        62800000
  OUTPUT PARAMETERS:                                                    62805000
                                                                        62810000
    B08'END'JOB, a two word (double) function return.  The              62815000
      first word is the completion status of the call.  The             62820000
      second word is the transfer count of the job report               62825000
      status moved to a caller specified buffer.                        62830000
                                                                        62835000
                                                                        62840000
  SIDE-EFFECTS:                                                         62845000
                                                                        62850000
    Causes job to be closed, if one was active on the device.           62855000
    When the peripheral is finished with the job, a job status          62860000
    report will be returned.  If the caller has specified a             62865000
    destination buffer, the contents of the job report status           62870000
    will be moved to that buffer.                                       62875000
                                                                        62880000
                                                                        62885000
  SPECIAL CONSIDERATIONS:                                               62890000
                                                                        62895000
    When called, DB must be set to the base of the CIPER data           62900000
    segment.                                                            62905000
                                                                        62910000
                                                                        62915000
  CHANGE HISTORY:                                                       62920000
                                                                        62925000
    As issued.                                                          62930000
                                                                        62935000
;                                                                       62940000
                                                                        62945000
$PAGE "B08'END'JOB -- LOCAL DECLARATIONS"                               62950000
begin                                                                   62955000
                                                                        62960000
  << Completion status subparameters >>                                 62965000
                                                                        62970000
  integer                                                               62975000
                                                                        62980000
    return'status                 = b08'end'job                         62985000
      << contains procedure call completion status >>                   62990000
                                                                        62995000
   ,transfer'log                  = b08'end'job + 1                     63000000
      << Amount of data moved to caller specified buffer, >>            63005000
      << if any.                                          >>            63010000
                                                                        63015000
  ;                                                                     63020000
                                                                        63025000
                                                                        63030000
                                                                        63035000
  << Input and output data record buffer pointers >>                    63040000
                                                                        63045000
  integer pointer                                                       63050000
                                                                        63055000
    o'r'control                                                         63060000
      << control portion of output record buffer area >>                63065000
                                                                        63070000
   ,o'r'data                                                            63075000
      << data portion of output record buffer area >>                   63080000
                                                                        63085000
   ,i'r'control                                                         63090000
      << control portion of input record buffer area >>                 63095000
                                                                        63100000
  ;                                                                     63105000
                                                                        63110000
                                                                        63115000
  << Miscellaneous >>                                                   63120000
                                                                        63125000
  logical                                                               63130000
                                                                        63135000
    buffers'cleared                                                     63140000
      << true if all output buffers are cleared before the >>           63145000
      << job end command is sent.                          >>           63150000
                                                                        63155000
  ;                                                                     63160000
                                                                        63165000
                                                                        63170000
                                                                        63175000
                                                                        63180000
$PAGE "B08'END'JOB -- PROCEDURE BODY"                                   63185000
  << Is there a job active?  If not, just set up a good >>              63190000
  << status return and exit.                            >>              63195000
                                                                        63200000
  if not logical( cb'info(job'active) ) then                            63205000
    begin                                                               63210000
      return'status.general := successful;                              63215000
      transfer'log := 0;                                                63220000
    end                                                                 63225000
  else                                                                  63230000
                                                                        63235000
    << A job is active on the device.  Clean out any pen- >>            63240000
    << ding buffers and send the end of job record.       >>            63245000
                                                                        63250000
    begin                                                               63255000
      << Initialize output record pointers >>                           63260000
                                                                        63265000
      @o'r'control := cb'info(o'r'base)                                 63270000
                    + cb'info(cds'area'base);                           63275000
                                                                        63280000
      @o'r'data := o'r'control(start) + @o'r'control;                   63285000
                                                                        63290000
                                                                        63295000
      << Check for active buffers, and send any that are >>             63300000
                                                                        63305000
      if logical( o'r'control(active) ) then                            63310000
        begin                                                           63315000
          return'status := cpr'send'record(cb'info,                     63320000
                                           o'r'control);                63325000
          if return'status.general = successful then                    63330000
            begin                                                       63335000
              buffers'cleared := true;                                  63340000
            end                                                         63345000
          else                                                          63350000
            begin                                                       63355000
              buffers'cleared := false;                                 63360000
            end;                                                        63365000
        end                                                             63370000
      else                                                              63375000
        begin                                                           63380000
          buffers'cleared := true;                                      63385000
        end;                                                            63390000
                                                                        63395000
                                                                        63400000
      << If buffers are now clear, build the job end command >>         63405000
      << record and complete the sequence.                   >>         63410000
                                                                        63415000
      if buffers'cleared then                                           63420000
        begin                                                           63425000
                                                                        63430000
          << Build the job end record >>                                63435000
                                                                        63440000
          b08'build'header( o'r'control,                                63445000
                            lgl'end'job,                                63450000
                            , << no data'type used >>          <<04422>>63455000
                            set'bit, << sob'flag >>            <<04422>>63460000
                            set'bit  << eob'flag >>    );      <<04422>>63465000
                                                                        63470000
                                                                        63475000
          << Send the completed record to the device >>                 63480000
                                                                        63485000
          return'status := cpr'send'record(cb'info,                     63490000
                                           o'r'control);                63495000
                                                                        63500000
                                                                        63505000
          << If the job end was successfully sent, wait for >>          63510000
          << the job report to come in.                     >>          63515000
                                                                        63520000
          if return'status.general = successful then                    63525000
            begin                                                       63530000
                                                                        63535000
              << Initialize the input record pointer >>                 63540000
                                                                        63545000
              @i'r'control := cb'info(i'r'base)                         63550000
                            + cb'info(cds'area'base);                   63555000
                                                                        63560000
                                                                        63565000
              << Wait for the report to come in >>                      63570000
                                                                        63575000
              return'status := cpr'get'record(cb'info,                  63580000
                                              i'r'control,              63585000
                                              lgl'job'report);          63590000
                                                                        63595000
              if return'status.general = successful then                63600000
                                                                        63605000
                << We got a job report.  Move it into the >>            63610000
                << job report status tank, and the caller's >>          63615000
                << buffer, if any.                          >>          63620000
                                                                        63625000
                begin                                                   63630000
                  << Mark the job inactive >>                           63635000
                                                                        63640000
                  cb'info(job'active) := false;                         63645000
                                                                        63650000
                                                                        63655000
                  b08'job'report(cb'info, i'r'control);                 63660000
                                                                        63665000
                  if count <> 0 then                                    63670000
                    begin                                               63675000
                      b08'end'job :=                                    63680000
                        b08'return'job'report(cb'info,                  63685000
                                              dst'num,                  63690000
                                              address,                  63695000
                                              count,                    63700000
                                              false   );                63705000
                    end;                                                63710000
                end;                                                    63715000
                                                                        63720000
            end;                                                        63725000
        end;                                                            63730000
    end;                                                                63735000
                                                                        63740000
                                                                        63745000
end;  << of procedure b08'end'job >>                                    63750000
                                                                        63755000
$PAGE "PROCEDURE:  B08'START'JOB"                                       63760000
double procedure b08'start'job( cb'info, start'of'job'parm );           63765000
                                                                        63770000
  value                         cb'info, start'of'job'parm  ;           63775000
                                                                        63780000
  integer pointer               cb'info                     ;           63785000
                                                                        63790000
  integer                                start'of'job'parm  ;           63795000
                                                                        63800000
  option privileged, uncallable                             ;           63805000
                                                                        63810000
COMMENT                                                                 63815000
                                                                        63820000
                                                                        63825000
  PURPOSE:                                                              63830000
                                                                        63835000
    This procedure will send the START OF JOB command to the            63840000
    peripheral, then clean up any job related information in            63845000
    the control block information area, and finally will set            63850000
    the job active flag true.                                           63855000
                                                                        63860000
                                                                        63865000
  INPUT PARAMETERS:                                                     63870000
                                                                        63875000
    CB'INFO, a pointer to the control block information area,           63880000
      which is the global storage area for the logical driver.          63885000
                                                                        63890000
    START'OF'JOB'PARM, which indicates whether any program-             63895000
      mable features are to be reset or not.  Only the least            63900000
      significant bit carries any meaning, the others are re-           63905000
      served for now.  A value of zero does not reset program-          63910000
      mable features, a value of one does cause a reset.                63915000
                                                                        63920000
                                                                        63925000
  OUTPUT PARAMETERS:                                                    63930000
                                                                        63935000
    B08'START'JOB, which is the completion status of this pro-          63940000
      cedure.  A value of zero is returned if no errors occurred.       63945000
      Other values will be defined as required.                         63950000
                                                                        63955000
                                                                        63960000
  SIDE-EFFECTS:                                                         63965000
                                                                        63970000
    This procedure will cause the modification of certain               63975000
    information contained in the control block information              63980000
    area.  Specifically, the job flag will get set or reset             63985000
    depending on the completion status.  Other information              63990000
    will be modified indirectly, since an output record will            63995000
    be sent to the peripheral.                                          64000000
                                                                        64005000
                                                                        64010000
  SPECIAL CONSIDERATIONS:                                               64015000
                                                                        64020000
    When called, DB must be set to the CIPER data segment.              64025000
                                                                        64030000
                                                                        64035000
  CHANGE HISTORY:                                                       64040000
                                                                        64045000
    As issued.                                                          64050000
                                                                        64055000
                                                                        64060000
;                                                                       64065000
$PAGE "PROCEDURE:  B08'START'JOB -- LOCAL VARIABLES"                    64070000
begin                                                                   64075000
                                                                        64080000
  << DECLARATION OF LOCAL VARIABLES >>                                  64085000
                                                                        64090000
  integer pointer                                                       64095000
                                                                        64100000
    o'r'control                                                         64105000
      << points to output record control area >>                        64110000
                                                                        64115000
   ,output'record                                                       64120000
      << points to output record buffer area >>                         64125000
                                                                        64130000
  ;                                                                     64135000
                                                                        64140000
  double                                                                64145000
                                                                        64150000
    return'info                   = b08'start'job                       64155000
      << Contains completion status and transfer log >>                 64160000
                                                                        64165000
  ;                                                                     64170000
                                                                        64175000
                                                                        64180000
                                                                        64185000
  integer                                                               64190000
                                                                        64195000
    error'parm                    = return'info                         64200000
      << used for completion information from other proc's >>           64205000
                                                                        64210000
   ,transfer'log                  = return'info + 1                     64215000
      << total data count sent to peripheral >>                         64220000
                                                                        64225000
                                                                        64230000
  ;                                                                     64235000
                                                                        64240000
                                                                        64245000
  integer pointer                                                       64250000
                                                                        64255000
    control'table                                                       64260000
      << Control table contains the access mode default >>              64265000
                                                                        64270000
  ;                                                                     64275000
                                                                        64280000
                                                                        64285000
  equate                                                                64290000
                                                                        64295000
    job'start'length              = 1                                   64300000
      << length of job start parameter information >>                   64305000
                                                                        64310000
  ;                                                                     64315000
                                                               <<04472>>64320000
                                                               <<04472>>64325000
  byte pointer                                                 <<04472>>64330000
                                                               <<04472>>64335000
    sequence'1'buffer   := 0                                   <<04472>>64340000
      << Dummy pointer used when calling cpr'xlate >>          <<04472>>64345000
                                                               <<04472>>64350000
   ,sequence'2'buffer   := 0                                   <<04472>>64355000
      << Dummy pointer used when calling cpr'xlate >>          <<04472>>64360000
                                                               <<04472>>64365000
  ;                                                            <<04472>>64370000
$PAGE "PROCEDURE:  B08'START'JOB -- PROCEDURE BODY"                     64375000
  << Set up the default feature access mode.  It is done  >>            64380000
  << At this point just in case something fails; then we  >>            64385000
  << will always end up the the correct mode.             >>            64390000
                                                                        64395000
  cb'info(expanded'features) :=                                         64400000
      cb'info(default'access'mode);                                     64405000
                                                                        64410000
                                                                        64415000
  << Check to see if a job is already active.  If there is, >>          64420000
  << call b08'job'end to complete that job, then start this >>          64425000
  << one.                                                   >>          64430000
                                                                        64435000
  if logical(cb'info(job'active)) then                                  64440000
    begin                                                               64445000
      << There is a job active.  Finish it up. >>                       64450000
                                                                        64455000
      return'info := b08'end'job(cb'info, 0, 0, 0, 0 );                 64460000
                                                                        64465000
      << Check the error'parm >>                                        64470000
                                                                        64475000
      if error'parm <> no'errors then                                   64480000
        begin                                                           64485000
          << Could not finish the last job.  Return an error >>         64490000
                                                                        64495000
          return;                                                       64500000
        end;                                                            64505000
    end;  << of previous job still active >>                            64510000
                                                                        64515000
  << Initialize local variables >>                                      64520000
                                                                        64525000
  @o'r'control := cb'info(o'r'base)                                     64530000
                + cb'info(cds'area'base);                               64535000
  @output'record := o'r'control(start) + @o'r'control;                  64540000
                                                                        64545000
  << Now we can start this job >>                                       64550000
  << First check to see if the output buffer area is free. >>           64555000
                                                                        64560000
  if logical(o'r'control(active)) then                                  64565000
    begin                                                               64570000
      << There was an active output record inbetween jobs. >>           64575000
      << Send it to the peripheral.                        >>           64580000
                                                                        64585000
      error'parm := cpr'send'record(cb'info,o'r'control);               64590000
                                                                        64595000
      << check for errors >>                                            64600000
      if error'parm = no'errors then                                    64605000
        begin                                                           64610000
          << Record was successfully sent.  Mark the record >>          64615000
          << buffer as available.                           >>          64620000
                                                                        64625000
          o'r'control(active) := integer(free);                         64630000
        end                                                             64635000
      else                                                              64640000
        begin                                                           64645000
          << Could not send the record for some reason.  Re- >>         64650000
          << turn the error information.                     >>         64655000
                                                                        64660000
          return;                                                       64665000
        end;                                                            64670000
                                                                        64675000
    end;                                                                64680000
                                                                        64685000
  << We now have a clean output buffer with which to work. >>           64690000
  << Build the job start record and send it to the device. >>           64695000
                                                                        64700000
  b08'build'header( o'r'control,                                        64705000
                    lgl'start'job,                                      64710000
                    , << no data'type used >>                  <<04422>>64715000
                    set'bit, << sob'flag >>                    <<04422>>64720000
                    set'bit  << eob'flag >>   );               <<04422>>64725000
                                                                        64730000
  output'record(parm'byte'1) := start'of'job'parm.bit'15;               64735000
                                                                        64740000
  o'r'control(current'position) :=                                      64745000
      o'r'control(current'position) + job'start'length;                 64750000
                                                                        64755000
  o'r'control(current'length) :=                                        64760000
      o'r'control(current'length) + job'start'length;                   64765000
                                                                        64770000
  error'parm := cpr'send'record(cb'info,o'r'control);                   64775000
                                                                        64780000
  << check the error'parm >>                                            64785000
                                                                        64790000
  if error'parm = no'errors then                                        64795000
    begin                                                               64800000
      << Job start was successful.  Set job active flag. >>             64805000
                                                                        64810000
      cpr'xlate( cb'info(xlate'flags)                          <<04472>>64815000
                ,sequence'1'buffer                             <<04472>>64820000
                ,sequence'2'buffer                             <<04472>>64825000
                ,start'job                                     <<04472>>64830000
                ,0  << parm1 >>                                <<04472>>64835000
                ,0  << parm2 >>                                <<04472>>64840000
                ,0  << byte count >>                           <<04472>>64845000
                ,false << no previous odd buffer address >>    <<04472>>64850000
                ,not logical( cb'info(expanded'features) )     <<04472>>64855000
               );                                              <<04472>>64860000
      cb'info(job'active) := true;                                      64865000
                                                                        64870000
    end                                                                 64875000
  else                                                                  64880000
    begin                                                               64885000
      << Job start failed.  Clear job active flag and  >>               64890000
      << report error condition.                       >>               64895000
                                                                        64900000
      cb'info(job'active) := false;                                     64905000
    end;                                                                64910000
                                                                        64915000
end;  << of b08'job'start >>                                            64920000
                                                                        64925000
$IF X9=ON                                                               64930000
$PAGE "TERMINAL SOFTKEY SETUP PROCEDURE"                                64935000
integer procedure b08'debug'softkeys(cb'info);                          64940000
                                                                        64945000
  value                              cb'info ;                          64950000
                                                                        64955000
  integer pointer                    cb'info ;                          64960000
                                                                        64965000
 option privileged, uncallable;                                         64970000
                                                                        64975000
                                                                        64980000
COMMENT                                                                 64985000
                                                                        64990000
  PURPOSE:                                                              64995000
    This procedure will load the softkeys of a 264X terminal            65000000
    with debug commands useful for observing the contents of            65005000
    critical CIPER data segment areas.  In particular, the              65010000
    softkey assignments are as follows:                                 65015000
                                                                        65020000
    f1 := display q-11,12  (calling parameters to procedures)           65025000
                                                                        65030000
    f2 := display cb'info  (control block information area)             65035000
                                                                        65040000
    f3 := display o'r'base (output record control info)                 65045000
                                                                        65050000
    f4 := display output record buffer for %50 words                    65055000
                                                                        65060000
    f5 := display i'r'base (input record control info)                  65065000
                                                                        65070000
    f6 := display input record buffer for %50 words                     65075000
                                                                        65080000
    f7 := disply ldtx entry for this logical device                     65085000
                                                                        65090000
    f8 := modify ldtx entry for this logical device                     65095000
                                                                        65100000
  INPUTS:                                                               65105000
                                                                        65110000
    CB'INFO, which is the DB relative address of the base of            65115000
      the control block information area of the CIPER dst.              65120000
      This area contains the information required to set up the         65125000
      various softkeys.                                                 65130000
                                                                        65135000
                                                                        65140000
  OUTPUTS:                                                              65145000
                                                                        65150000
    None.                                                               65155000
                                                                        65160000
                                                                        65165000
  SPECIAL CONSIDERATIONS:                                               65170000
                                                                        65175000
    This procedure uses a Q relative array to build the es-             65180000
    cape sequences needed to program the terminal's softkeys.           65185000
    Just before calling the PRINT intrinsic to send each                65190000
    escape sequence, EXCHANGEDB is called to put DB back to             65195000
    the user's stack.  After PRINT returns, DB will be set              65200000
    back to the CIPER dst.  THIS PROCEDURE ASSUMES DB IS SET            65205000
    TO THE CIPER DST UPON ENTRY.                                        65210000
                                                                        65215000
                                                                        65220000
  SIDE-EFFECT:                                                          65225000
                                                                        65230000
    None.                                                               65235000
                                                                        65240000
;                                                                       65245000
                                                                        65250000
begin                                                                   65255000
$PAGE "PROCEDURE:  B08'DEBUG'SOFTKEYS;  LOCAL DECLARATIONS"             65260000
  << DECLARATION OF LOCAL VARIABLES >>                                  65265000
                                                                        65270000
  equate                                                                65275000
                                                                        65280000
    debug'suptype'def             = [8/10,8/0]                          65285000
                                                                        65290000
  ;                                                                     65295000
                                                                        65300000
                                                                        65305000
  integer pointer                                                       65310000
    data'info                                                           65315000
      << used for pointing to various pieces of information >>          65320000
      << inside of the CIPER dst.                           >>          65325000
                                                                        65330000
   ,ldt                                                                 65335000
      << points to the LOCAL copy of the ldt >>                <<07425>>65340000
                                                                        65345000
   ,sequence'buffer                                                     65350000
      << points to buffer where escape sequences are made >>            65355000
                                                                        65360000
  ;                                                                     65365000
                                                                        65370000
  integer                                                               65375000
                                                                        65380000
    seq'length                                                          65385000
      << total length of escape sequence in bytes >>                    65390000
                                                                        65395000
   ,our'dst                                                             65400000
      << contains the dst number of the CIPER dst. >>                   65405000
                                                                        65410000
   ,our'ldtx                                                            65415000
      << contains the ldtx address of the current ldev. >>              65420000
                                                                        65425000
   ,our'ldev                                                            65430000
      << contains the logical device number of the CIPER  >>            65435000
      << printer we are working on.                       >>            65440000
                                                                        65445000
   ,error'parm                                                          65450000
      << used for error reporting >>                                    65455000
                                                                        65460000
   ,file'number                                                         65465000
      << contains the file number of $stdin >>                          65470000
  ;                                                                     65475000
                                                                        65480000
  array sequence'header(0:3)      = PB :=                               65485000
      %15446,"f2","a8","d "                                             65490000
  ;                                                                     65495000
                                                                        65500000
  byte pointer                                                          65505000
                                                                        65510000
    next'byte                                                           65515000
      << points to next available byte in sequence buffer >>            65520000
                                                                        65525000
   ,b'sequence'buffer                                                   65530000
      << byte array pointing to sequence buffer >>                      65535000
                                                                        65540000
  ;                                                                     65545000
                                                                        65550000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            65555000
equate                                                                  65560000
       table'entry'data    = 0                                          65565000
      ,table'entry'size    = -1 + table'entry'data                      65570000
      ,table'status        = -1 + table'entry'size                      65575000
      ,table'current'entry = -1 + table'status                          65580000
      ,table'base          = -1 + table'current'entry                   65585000
      ,table'dst           = -1 + table'base                            65590000
      ,table'sir           = -1 + table'dst                             65595000
      ,table'overhead      = -table'sir                                 65600000
;                                                                       65605000
define                                                                  65610000
       table'clean         = table'status).(0:1 #                       65615000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               65620000
      ,table'auto'sir      = table'status).(1:1 #                       65625000
      ,table'getsir'save   = table'status).(2:2 #                       65630000
      ,table'type          = table'status).(13:3 #                      65635000
;                                                                       65640000
                                                                        65645000
intrinsic                                                               65650000
                                                                        65655000
  fopen                                                                 65660000
 ,fwrite                                                                65665000
 ,fclose                                                                65670000
                                                                        65675000
;                                                                       65680000
                                                                        65685000
  declare'move'from'data'segment;                                       65690000
                                                                        65695000
  declare'move'to'data'segment;                                         65700000
                                                                        65705000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  65710000
subroutine open'table(T, dst, base, type, sir, auto'sir);               65715000
value                    dst, base, type, sir, auto'sir ;               65720000
logical pointer       T                                 ;               65725000
integer                  dst, base, type, sir           ;               65730000
logical                                        auto'sir ;               65735000
begin                                                 <<sxit return>>   65740000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           65745000
                                                                        65750000
COMMENT                                                                 65755000
                                                                        65760000
Purpose:                                                                65765000
                                                                        65770000
Error reporting:                                                        65775000
                                                                        65780000
External references:                                                    65785000
                                                                        65790000
Input:                                                                  65795000
                                                                        65800000
Output:                                                                 65805000
                                                                        65810000
Side effects:                                                           65815000
                                                                        65820000
Special considerations:  Must be called on the user's stack.            65825000
;                                                                       65830000
                                                                        65835000
  <<make some space on the stack directly under the calling             65840000
    parameters for the table'overhead area of table T of size           65845000
    table'overhead.>>                                                   65850000
assemble(lra s-0                                                        65855000
        ;stax                                                           65860000
        ;adds table'overhead <<the amount of space needed>>             65865000
        ;lra s-0  <<destination address>>                               65870000
        ;ldxa  <<source address>>                                       65875000
        ;ldni 7 <<the negative count of the parameter                   65880000
                  list size plus the return address  >>                 65885000
        ;move                                                           65890000
);                                                                      65895000
                                                                        65900000
  <<set the address of the table>>                                      65905000
assemble(lra s-6                                                        65910000
        ;stax                                                           65915000
);                                                                      65920000
@T:=x;                                                                  65925000
                                                                        65930000
  <<initialize the table's control area>>                               65935000
T(table'sir):=sir;                                                      65940000
T(table'dst):=dst;                                                      65945000
T(table'base):=base;                                                    65950000
T(table'current'entry):=0;                                              65955000
                                                                        65960000
  << T(table'status) variable >>                                        65965000
T(table'status) := 0;                                                   65970000
T(table'clean):=true;                                                   65975000
T(table'auto'sir):=auto'sir;                                            65980000
T(table'getsir'save):=0;                                                65985000
T(table'type):=type;                                                    65990000
                                                                        65995000
  << T(table'entry'size) >>                                             66000000
<< Extract the number of words in the entry for the >>         <<07425>>66005000
<< move from the extra data segment to the stack.   >>         <<07425>>66010000
<< If the table type is 0 then the entry size is    >>         <<07425>>66015000
<< already in the overhead area, else extract the   >>         <<07425>>66020000
<< count from word 1 of the zero'th entry.          >>         <<07425>>66025000
IF T(TABLE'TYPE) <> 0                                          <<07425>>66030000
   THEN                                                        <<07425>>66035000
      BEGIN                                                    <<07425>>66040000
      MFDS(T(TABLE'ENTRY'SIZE),  << TARGET WORD >>             <<07425>>66045000
           T(TABLE'DST),         << SOURCE DST # >>            <<07425>>66050000
           T(TABLE'BASE)+1,      << SOURCE OFFSET INTO XDS >>  <<07425>>66055000
           1);                   << COUNT >>                   <<07425>>66060000
      END;                                                     <<07425>>66065000
                                                               <<07425>>66070000
                                                               <<07425>>66075000
                                                               <<07425>>66080000
                                                                        66085000
  <<make some space on the stack directly under the calling             66090000
    parameters for the table'entry'data of size                         66095000
    = table(table'entry'size).>>                                        66100000
x:=T(table'entry'size);                                                 66105000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      66110000
                the return address in x.>>                              66115000
        ;adds 0 <<add the space to the stack.>>                         66120000
        ;ldxa  <<put the return address on the stack.>>                 66125000
);                                                                      66130000
                                                                        66135000
end;  <<open'table>>                                                    66140000
                                                                        66145000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   66150000
subroutine put'entry(T);                                                66155000
value                T ;                                                66160000
logical pointer      T ;                                                66165000
begin                                                                   66170000
                                                                        66175000
COMMENT                                                                 66180000
                                                                        66185000
Special considerations:  Must be called on the user's stack.            66190000
;                                                                       66195000
                                                                        66200000
if T(table'clean) then return;                                          66205000
                                                                        66210000
T(table'clean):=true;                                                   66215000
                                                                        66220000
mtds(T(table'dst),                     <<target'dseg'num>>              66225000
                                                                        66230000
     logical(integer(T(table'base)) +  <<target'offset>>                66235000
     integer(T(table'entry'size)) *                                     66240000
     integer(T(table'current'entry))),                                  66245000
                                                                        66250000
     T,                                <<source>>                       66255000
                                                                        66260000
     T(table'entry'size)               <<word'cnt>> );                  66265000
                                                                        66270000
if T(table'auto'sir) then                                               66275000
  relsir(T(table'sir), T(table'getsir'save));                           66280000
                                                                        66285000
end;  <<put'entry>>                                                     66290000
                                                                        66295000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   66300000
subroutine get'entry(T, index);                                         66305000
value                T, index ;                                         66310000
logical pointer      T        ;                                         66315000
integer                 index ;                                         66320000
begin                                                                   66325000
                                                                        66330000
COMMENT                                                                 66335000
                                                                        66340000
Special considerations:  Must be called on the user's stack.            66345000
;                                                                       66350000
                                                                        66355000
if not T(table'clean) then put'entry(T);                                66360000
                                                                        66365000
if T(table'auto'sir) then                                               66370000
  T(table'getsir'save):=getsir(T(table'sir));                           66375000
                                                                        66380000
mfds(T,                                <<target>>                       66385000
                                                                        66390000
     T(table'dst),                     <<source'dseg'num>>              66395000
                                                                        66400000
     logical(integer(T(table'base)) +  <<source'offset>>                66405000
     integer(T(table'entry'size)) *                                     66410000
     index),                                                            66415000
                                                                        66420000
     T(table'entry'size)               <<word'cnt>>);                   66425000
                                                                        66430000
T(table'current'entry):=index;                                          66435000
T(table'clean):=false;                                                  66440000
                                                                        66445000
end;  <<get'entry>>                                                     66450000
$PAGE "PROCEDURE:  B08'DEBUG'SOFTKEYS;  PROCEDURE BODY"                 66455000
  << Start of procedure body >>                                         66460000
                                                                        66465000
  << Pull out our logical device number before switching >>             66470000
  << to the caller's stack.                              >>             66475000
                                                                        66480000
  our'ldev := cb'info(logical'device);                                  66485000
                                                                        66490000
  << Switch to the caller's stack, perform an fopen on >>               66495000
  << $stdlist.  If that doesn't work, switch back to the >>             66500000
  << CIPER dst and return with an error.  If it does   >>               66505000
  << work, get the head entry of the ldt to and com-   >>               66510000
  << pute where our ldtx entry is located.  Then go    >>               66515000
  << back to the CIPER dst.                            >>               66520000
                                                                        66525000
  our'dst := exchangedb(0);                                             66530000
  file'number := fopen(,%217,%301);                                     66535000
  if <> then                                                            66540000
    begin                                                               66545000
      exchangedb(our'dst);                                              66550000
      b08'debug'softkeys := 2;                                          66555000
      return;                                                           66560000
    end;                                                                66565000
  open'table(ldt, ldt'dst, 0 <<base>>, 1 <<type>>, ldt'sir, false);     66570000
  get'entry(ldt, 0);                                                    66575000
     our'ldtx := ldtx'base                                     <<07425>>66580000
                 + ( our'ldev * ldt'entry'size);               <<07425>>66585000
  exchangedb(our'dst);                                                  66590000
                                                                        66595000
  << Set up the address in b'sequence'buffer to point >>                66600000
  << to the sequence buffer area.                     >>                66605000
                                                                        66610000
  @sequence'buffer := cpr'get'2ndary'cds'area(40,debug'suptype'def      66615000
                                       lor 7,0);                        66620000
  @b'sequence'buffer := @sequence'buffer to'byte;                       66625000
                                                                        66630000
  move sequence'buffer := sequence'header,(4);                          66635000
                                                                        66640000
                                                                        66645000
  << set up for softkey 1 >>                                            66650000
                                                                        66655000
  move b'sequence'buffer(8) := "1k 8LL4 parmsdq-11,12",2;               66660000
  @next'byte := tos;                                                    66665000
  seq'length := @next'byte - @b'sequence'buffer;                        66670000
  fwrite(file'number,sequence'buffer,-seq'length,0);                    66675000
                                                                        66680000
  << set up for softkey 2 >>                                            66685000
                                                                        66690000
  if = then                                                             66695000
    begin                                                               66700000
      move b'sequence'buffer(8) := "2k 23Lcb'info dda",2;               66705000
      @next'byte := tos;                                                66710000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        66715000
      next'byte := "+";                                                 66720000
      @next'byte := b08'ascii(@cb'info,8,next'byte(1))                  66725000
          + @next'byte + 1;                                             66730000
      next'byte := ",";                                                 66735000
      @next'byte := b08'ascii(cb'info'size,8,next'byte(1))              66740000
                  + @next'byte + 1;                                     66745000
      seq'length := @next'byte - @b'sequence'buffer;                    66750000
      fwrite(file'number,sequence'buffer,-seq'length,0);                66755000
    end;                                                                66760000
                                                                        66765000
                                                                        66770000
  << set up for softkey 3 >>                                            66775000
                                                                        66780000
  if = then                                                             66785000
    begin                                                               66790000
      @data'info := cb'info(o'r'base) + cb'info(cds'area'base);         66795000
      move b'sequence'buffer(8) := "3k 19Lo'r'basedda",2;               66800000
      @next'byte := tos;                                                66805000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        66810000
      next'byte := "+";                                                 66815000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                66820000
          + @next'byte + 1;                                             66825000
      move next'byte := ",10",2;                                        66830000
      @next'byte := tos;                                                66835000
      seq'length := @next'byte - @b'sequence'buffer;                    66840000
      fwrite(file'number,sequence'buffer,-seq'length,0);                66845000
    end;                                                                66850000
                                                                        66855000
                                                                        66860000
  << set up for softkey 4 >>                                            66865000
                                                                        66870000
  if = then                                                             66875000
    begin                                                               66880000
      @data'info := @data'info + data'info(start);                      66885000
      move b'sequence'buffer(8) := "4k 19Lo bufferdda",2;               66890000
      @next'byte := tos;                                                66895000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        66900000
      next'byte := "+";                                                 66905000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                66910000
          + @next'byte + 1;                                             66915000
      move next'byte := ",50",2;                                        66920000
      @next'byte := tos;                                                66925000
      seq'length := @next'byte - @b'sequence'buffer;                    66930000
      fwrite(file'number,sequence'buffer,-seq'length,0);                66935000
    end;                                                                66940000
                                                                        66945000
                                                                        66950000
  << set up for softkey 5 >>                                            66955000
                                                                        66960000
  if = then                                                             66965000
    begin                                                               66970000
      @data'info := cb'info(i'r'base) + cb'info(cds'area'base);         66975000
      move b'sequence'buffer(8) := "5k 19Li'r'basedda",2;               66980000
      @next'byte := tos;                                                66985000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        66990000
      next'byte := "+";                                                 66995000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                67000000
          + @next'byte + 1;                                             67005000
      move next'byte := ",10",2;                                        67010000
      @next'byte := tos;                                                67015000
      seq'length := @next'byte - @b'sequence'buffer;                    67020000
      fwrite(file'number,sequence'buffer,-seq'length,0);                67025000
    end;                                                                67030000
                                                                        67035000
                                                                        67040000
  << set up for softkey 6 >>                                            67045000
                                                                        67050000
  if = then                                                             67055000
    begin                                                               67060000
      @data'info := @data'info + data'info(start);                      67065000
      move b'sequence'buffer(8) := "6k 19Li bufferdda",2;               67070000
      @next'byte := tos;                                                67075000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        67080000
      next'byte := "+";                                                 67085000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                67090000
          + @next'byte + 1;                                             67095000
      move next'byte := ",50",2;                                        67100000
      @next'byte := tos;                                                67105000
      seq'length := @next'byte - @b'sequence'buffer;                    67110000
      fwrite(file'number,sequence'buffer,-seq'length,0);                67115000
    end;                                                                67120000
                                                                        67125000
                                                                        67130000
  << set up for the last two softkeys >>                                67135000
                                                                        67140000
                                                                        67145000
  << set up for softkey 7 >>                                            67150000
                                                                        67155000
  if = then                                                             67160000
    begin                                                               67165000
      move b'sequence'buffer(8) := "7k 14Lsee ldtxdda16+",2;            67170000
      @next'byte := tos;                                                67175000
      @next'byte := b08'ascii(our'ldtx,8,next'byte) + @next'byte;       67180000
      move next'byte := ",5",2;                                         67185000
      @next'byte := tos;                                                67190000
      seq'length := @next'byte - @b'sequence'buffer;                    67195000
      fwrite(file'number,sequence'buffer,-seq'length,0);                67200000
    end;                                                                67205000
                                                                        67210000
                                                                        67215000
  << set up for softkey 8 >>                                            67220000
                                                                        67225000
  if = then                                                             67230000
    begin                                                               67235000
      b'sequence'buffer(8) := "8";                                      67240000
      move b'sequence'buffer(14) := "fix";                              67245000
      b'sequence'buffer(22) := "m";                                     67250000
      fwrite(file'number,sequence'buffer,-seq'length,0);                67255000
    end;                                                                67260000
                                                                        67265000
                                                                        67270000
  << all done (for better or worse) so try to close the >>              67275000
  << terminal file.                                     >>              67280000
                                                                        67285000
  cpr'rel'cds'area(sequence'buffer);                                    67290000
                                                                        67295000
                                                                        67300000
  fclose(file'number,0,0);                                              67305000
  if = then                                                             67310000
    b08'debug'softkeys := 1                                             67315000
  else                                                                  67320000
    b08'debug'softkeys := 4                                             67325000
  ;                                                                     67330000
                                                                        67335000
                                                                        67340000
end;  << procedure b08'debug'softkeys >>                                67345000
$IF                                                                     67350000
                                                                        67355000
$PAGE "PROCEDURE:  B08'BUF'DEVICE'STATUS"                               67360000
double procedure b08'buf'device'status( cb'info, dst'num,               67365000
                                        address, count,                 67370000
                                        status'type'flag    );          67375000
                                                                        67380000
  value                                 cb'info, dst'num,               67385000
                                        address, count,                 67390000
                                        status'type'flag     ;          67395000
                                                                        67400000
  integer pointer                       cb'info             ;           67405000
                                                                        67410000
  integer                                        dst'num,               67415000
                                        address, count      ;           67420000
                                                                        67425000
  logical                               status'type'flag     ;          67430000
                                                                        67435000
  option privileged, uncallable                             ;           67440000
                                                                        67445000
                                                                        67450000
                                                                        67455000
COMMENT                                                                 67460000
                                                                        67465000
  PURPOSE:                                                              67470000
                                                                        67475000
    This procedure will move the contents of the device status          67480000
    area to a user buffer specified by the calling parameters.          67485000
    Normally, the existing copy of status will be returned,             67490000
    but if the caller specifies, a new copy will be obtained            67495000
    from the device before returning to the caller.                     67500000
                                                                        67505000
  INPUTS:                                                               67510000
                                                                        67515000
    CB'INFO, a pointer to the control block information area            67520000
      for this ldev's level 7.                                          67525000
                                                                        67530000
    DST'NUM, the index of the data segment to which the en-             67535000
      vironmental status information will be moved.                     67540000
                                                                        67545000
    ADDRESS, the offset within dst'num where the data will be           67550000
      moved to.                                                         67555000
                                                                        67560000
    COUNT, the number of bytes/words to be moved.  If count is          67565000
      negative, then it is a byte count.  If it is positive,            67570000
      it is a word count.                                               67575000
                                                                        67580000
    STATUS'TYPE'FLAG, which indicates whether the caller                67585000
      wants the last status obtained (0), a new copy (1), or            67590000
      the composite copy obtained from the last call (2).               67595000
                                                                        67600000
                                                                        67605000
  OUTPUTS:                                                              67610000
                                                                        67615000
    B08'BUF'DEVICE'STATUS, a double word function return,               67620000
      contains the completion status for the call in the most           67625000
      significant word, and the transfer log in the least sig-          67630000
      nificant word.  The transfer log maintains the same               67635000
      sense as the input count parameter.                               67640000
                                                                        67645000
  SIDE-EFFECTS:                                                         67650000
                                                                        67655000
    None.                                                               67660000
                                                                        67665000
  SPECIAL CONSIDERATIONS:                                               67670000
                                                                        67675000
    When called, DB should be set to the base of the CIPER              67680000
    data segment.                                                       67685000
                                                                        67690000
                                                                        67695000
  CHANGE HISTORY:                                                       67700000
                                                                        67705000
                                                                        67710000
                                                                        67715000
;                                                                       67720000
                                                                        67725000
$PAGE "PROCEDURE:  B08'BUF'DEVICE'STATUS -- LOCAL DECLARATIONS"         67730000
begin                                                                   67735000
                                                                        67740000
  << Declaration of local variables >>                                  67745000
                                                                        67750000
  integer pointer                                                       67755000
                                                                        67760000
    dev'status'info                                                     67765000
      << points to base of environmental status information >>          67770000
                                                                        67775000
  ;                                                                     67780000
                                                                        67785000
                                                                        67790000
  logical                                                               67795000
                                                                        67800000
    count'was'negative                                                  67805000
      << flag that transfer log must be converted to bytes >>           67810000
                                                                        67815000
  ;                                                                     67820000
                                                                        67825000
                                                                        67830000
  double                                                                67835000
                                                                        67840000
    return'information            = b08'buf'device'status               67845000
                                                                        67850000
  ;                                                                     67855000
                                                                        67860000
                                                                        67865000
  integer                                                               67870000
                                                                        67875000
    return'status                  = b08'buf'device'status              67880000
      << completion status of the call >>                               67885000
                                                                        67890000
   ,transfer'log                  = b08'buf'device'status + 1           67895000
      << byte/word count of data transferred to user >>                 67900000
                                                                        67905000
  ;                                                                     67910000
                                                                        67915000
                                                                        67920000
  integer pointer                                                       67925000
                                                                        67930000
    i'o'control                                                         67935000
      << points to control portion of record buffer area, >>            67940000
      << if one is allocated to request and receive a new >>            67945000
      << copy of the environmental status block.          >>            67950000
                                                                        67955000
  ;                                                                     67960000
                                                                        67965000
                                                                        67970000
  << Valid values for status'type'flag: >>                              67975000
                                                                        67980000
  equate                                                                67985000
                                                                        67990000
    buffered                      = 0                                   67995000
      << Requests whatever status is buffered >>                        68000000
                                                                        68005000
   ,immediate                     = 1                                   68010000
      << Requests a new copy from the device >>                         68015000
                                                                        68020000
   ,composite                     = 2                                   68025000
      << Requests the composite copy >>                                 68030000
                                                                        68035000
  ;                                                                     68040000
                                                                        68045000
  declare'move'to'data'segment;                                         68050000
$PAGE "PROCEDURE:  B08'BUF'DEVICE'STATUS -- PROCEDURE BODY"             68055000
  << If the caller requested a new copy of the environmental >>         68060000
  << status, allocate a record buffer, build the request,    >>         68065000
  << and get the reply back.                                 >>         68070000
                                                                        68075000
  if status'type'flag then                                              68080000
    begin                                                               68085000
                                                                        68090000
      @i'o'control := b08'get'buffer( cb'info, no'overwrite );          68095000
      if @i'o'control = nil then                                        68100000
        begin                                                           68105000
          return'status := fatal'error;                                 68110000
          return;                                                       68115000
        end;                                                            68120000
                                                                        68125000
      b08'build'header( i'o'control,                                    68130000
                        lgl'report'status,                              68135000
                       , << no data'type used >>               <<04422>>68140000
                       set'bit, << sob'flag >>                 <<04422>>68145000
                       set'bit  << eob'flag >>    );           <<04422>>68150000
                                                                        68155000
      return'status := cpr'send'record( cb'info,                        68160000
                                        i'o'control );                  68165000
                                                                        68170000
      if return'status.general <> successful then                       68175000
        begin                                                           68180000
          b08'release'buffer(cb'info, i'o'control);                     68185000
          return;                                                       68190000
        end;                                                            68195000
                                                                        68200000
      return'status := cpr'get'record( cb'info,                         68205000
                                       i'o'control,                     68210000
                                       lgl'status'report );             68215000
                                                                        68220000
      if return'status.general <> successful then                       68225000
        begin                                                           68230000
          b08'release'buffer(cb'info, i'o'control);                     68235000
          return;                                                       68240000
        end;                                                            68245000
                                                                        68250000
      b08'device'status( cb'info, i'o'control );                        68255000
                                                                        68260000
      b08'release'buffer(cb'info, i'o'control);                         68265000
                                                                        68270000
    end;  << of if status'type'flag >>                                  68275000
                                                                        68280000
                                                                        68285000
  << Initialize the pointer to the status info >>                       68290000
                                                                        68295000
  if status'type'flag = composite then                                  68300000
    begin                                                               68305000
      @dev'status'info := cb'info(composite'status'base)                68310000
                        + cb'info(cds'area'base);                       68315000
    end                                                                 68320000
  else                                                                  68325000
    begin                                                               68330000
      @dev'status'info := cb'info(dev'status'base)                      68335000
                        + cb'info(cds'area'base);                       68340000
  end;                                                                  68345000
                                                                        68350000
                                                                        68355000
  << First, make count into a word count if it is not >>                68360000
                                                                        68365000
  if count < 0 then                                                     68370000
    begin                                                               68375000
      count := (-count) to'word;                                        68380000
      count'was'negative := true;                                       68385000
    end                                                                 68390000
  else                                                                  68395000
    begin                                                               68400000
      count'was'negative := false;                                      68405000
    end;                                                                68410000
                                                                        68415000
                                                                        68420000
  << Now determine if the count is large enough to move all >>          68425000
  << of the status, or just a part of it.                   >>          68430000
                                                                        68435000
  if count > device'status'length to'word then                          68440000
    begin                                                               68445000
      count := device'status'length to'word;                            68450000
    end;                                                                68455000
                                                                        68460000
                                                                        68465000
  << Move the data to the user's dst >>                                 68470000
                                                                        68475000
  if count > 0 then                                            <<04434>>68480000
    begin                                                      <<04434>>68485000
      mtds(dst'num,address,dev'status'info,count);             <<04434>>68490000
    end;                                                       <<04434>>68495000
                                                                        68500000
                                                                        68505000
  << Adjust the transfer log count >>                                   68510000
                                                                        68515000
  if count'was'negative then                                            68520000
    begin                                                               68525000
      transfer'log := -(count to'byte);                                 68530000
    end                                                                 68535000
  else                                                                  68540000
    begin                                                               68545000
      transfer'log := count;                                            68550000
    end;                                                                68555000
                                                                        68560000
                                                                        68565000
  << Since we are returning the current available status, >>            68570000
  << clear the status'received and status'reported bits   >>            68575000
  << in cb'info.                                          >>            68580000
                                                                        68585000
  cb'info(status'received).dev'stat'bit := clear'bit;                   68590000
  cb'info(status'reported).dev'stat'bit := clear'bit;                   68595000
                                                                        68600000
  if status'type'flag = composite then                                  68605000
    begin                                                               68610000
      b08'clean'comp'status( cb'info );                                 68615000
    end;                                                                68620000
                                                                        68625000
                                                                        68630000
  << Set the completion code >>                                         68635000
                                                                        68640000
  return'status := no'errors;                                           68645000
                                                                        68650000
end;  << of procedure b08'buf'device'status >>                          68655000
                                                                        68660000
$PAGE "PROCEDURE:  B08'BUFFERED'ENV'STATUS"                             68665000
double procedure b08'buffered'env'status(cb'info, dst'num,              68670000
                                         address, count,                68675000
                                         new'status'flag    );          68680000
                                                                        68685000
  value                                  cb'info, dst'num,              68690000
                                         address, count,                68695000
                                         new'status'flag     ;          68700000
                                                                        68705000
  integer pointer                        cb'info             ;          68710000
                                                                        68715000
  integer                                         dst'num,              68720000
                                         address, count      ;          68725000
                                                                        68730000
  logical                                new'status'flag     ;          68735000
                                                                        68740000
  option privileged, uncallable                              ;          68745000
                                                                        68750000
                                                                        68755000
                                                                        68760000
COMMENT                                                                 68765000
                                                                        68770000
  PURPOSE:                                                              68775000
                                                                        68780000
    This procedure will move the contents of the device en-             68785000
    vironmental status area to a user buffer specified by the           68790000
    calling parameters.  Typically no new status will be re-            68795000
    quested from the peripheral, but if new'status'flag is non          68800000
    zero, then a fresh copy of the status will be obtained.             68805000
                                                                        68810000
                                                                        68815000
  INPUT PARAMETERS:                                                     68820000
                                                                        68825000
    CB'INFO, a pointer to the control block information area            68830000
      for this ldev's level 7.                                          68835000
                                                                        68840000
    DST'NUM, the index of the data segment to which the en-             68845000
      vironmental status information will be moved.                     68850000
                                                                        68855000
    ADDRESS, the offset within dst'num where the data will be           68860000
      moved to.                                                         68865000
                                                                        68870000
    COUNT, the number of bytes/words to be moved.  If count is          68875000
      negative, then it is a byte count.  If it is positive,            68880000
      it is a word count.                                               68885000
                                                                        68890000
    NEW'STATUS'FLAG, which indicates whether the caller wants           68895000
      the last status obtained (false) or a new copy (true).            68900000
                                                                        68905000
                                                                        68910000
  OUTPUT PARAMETERS:                                                    68915000
                                                                        68920000
    B08'BUFFERED'ENV'STATUS, a double word function return,             68925000
      contains the completion status for the call in the most           68930000
      significant word, and the transfer log in the least sig-          68935000
      nificant word.  The transfer log maintains the same               68940000
      sense as the input count parameter.                               68945000
                                                                        68950000
                                                                        68955000
  SIDE-EFFECTS:                                                         68960000
    None.                                                               68965000
                                                                        68970000
                                                                        68975000
                                                                        68980000
  SPECIAL CONSIDERATIONS:                                               68985000
                                                                        68990000
    When called, DB should be set to the base of the CIPER              68995000
    data segment.                                                       69000000
                                                                        69005000
                                                                        69010000
  CHANGE HISTORY:                                                       69015000
                                                                        69020000
                                                                        69025000
                                                                        69030000
;                                                                       69035000
                                                                        69040000
$PAGE "PROCEDURE:  B08'BUFFERED'ENV'STATUS -- LOCAL DECLARATIONS"       69045000
begin                                                                   69050000
                                                                        69055000
  << Declaration of local variables >>                                  69060000
                                                                        69065000
  integer pointer                                                       69070000
                                                                        69075000
    env'status'info                                                     69080000
      << points to base of environmental status information >>          69085000
                                                                        69090000
  ;                                                                     69095000
                                                                        69100000
                                                                        69105000
  logical                                                               69110000
                                                                        69115000
    count'was'negative                                                  69120000
      << flag that transfer log must be converted to bytes >>           69125000
                                                                        69130000
  ;                                                                     69135000
                                                                        69140000
                                                                        69145000
  double                                                                69150000
                                                                        69155000
    return'information            = b08'buffered'env'status             69160000
                                                                        69165000
  ;                                                                     69170000
                                                                        69175000
                                                                        69180000
  integer                                                               69185000
                                                                        69190000
    return'status                  = b08'buffered'env'status            69195000
      << completion status of the call >>                               69200000
                                                                        69205000
   ,transfer'log                  = b08'buffered'env'status + 1         69210000
      << byte/word count of data transferred to user >>                 69215000
                                                                        69220000
  ;                                                                     69225000
                                                                        69230000
                                                                        69235000
  integer pointer                                                       69240000
                                                                        69245000
    i'o'control                                                         69250000
      << points to control portion of record buffer area, >>            69255000
      << if one is allocated to request and receive a new >>            69260000
      << copy of the environmental status block.          >>            69265000
                                                                        69270000
  ;                                                                     69275000
                                                                        69280000
  declare'move'to'data'segment;                                         69285000
$PAGE "PROCEDURE:  B08'BUFFERED'ENV'STATUS -- PROCEDURE BODY"           69290000
  << If the caller requested a new copy of the environmental >>         69295000
  << status, allocate a record buffer, build the request,    >>         69300000
  << and get the reply back.                                 >>         69305000
                                                                        69310000
  if new'status'flag then                                               69315000
    begin                                                               69320000
                                                                        69325000
      @i'o'control := b08'get'buffer( cb'info, no'overwrite );          69330000
      if @i'o'control = nil then                                        69335000
        begin                                                           69340000
          return'status := fatal'error;                                 69345000
          return;                                                       69350000
        end;                                                            69355000
                                                                        69360000
      b08'build'header( i'o'control,                                    69365000
                        lgl'report'esb,                                 69370000
                        , << no data'type used >>              <<04422>>69375000
                        set'bit, << sob'flag >>                <<04422>>69380000
                        set'bit  << eob'flag >>   );           <<04422>>69385000
                                                                        69390000
      return'status := cpr'send'record( cb'info,                        69395000
                                        i'o'control );                  69400000
                                                                        69405000
      if return'status.general <> successful then                       69410000
        begin                                                           69415000
          b08'release'buffer(cb'info, i'o'control);                     69420000
          return;                                                       69425000
        end;                                                            69430000
                                                                        69435000
      return'status := cpr'get'record( cb'info,                         69440000
                                       i'o'control,                     69445000
                                       lgl'esb'report );                69450000
                                                                        69455000
      if return'status.general <> successful then                       69460000
        begin                                                           69465000
          b08'release'buffer(cb'info, i'o'control);                     69470000
          return;                                                       69475000
        end;                                                            69480000
                                                                        69485000
      b08'env'status( cb'info, i'o'control );                           69490000
                                                                        69495000
      b08'release'buffer(cb'info, i'o'control);                         69500000
                                                                        69505000
    end;  << of if new'status'flag >>                                   69510000
                                                                        69515000
                                                                        69520000
  << Initialize the pointer to the status info >>                       69525000
                                                                        69530000
  @env'status'info := cb'info(env'status'base)                          69535000
                    + cb'info(cds'area'base);                           69540000
                                                                        69545000
                                                                        69550000
  << First, make count into a word count if it is not >>                69555000
                                                                        69560000
  if count < 0 then                                                     69565000
    begin                                                               69570000
      count := (-count) to'word;                                        69575000
      count'was'negative := true;                                       69580000
    end                                                                 69585000
  else                                                                  69590000
    begin                                                               69595000
      count'was'negative := false;                                      69600000
    end;                                                                69605000
                                                                        69610000
                                                                        69615000
  << Now determine if the count is large enough to move all >>          69620000
  << of the status, or just a part of it.                   >>          69625000
                                                                        69630000
  if count > (cb'info(device'env'status'size) to'word) then             69635000
    begin                                                               69640000
      count := cb'info(device'env'status'size) to'word;                 69645000
    end;                                                                69650000
                                                                        69655000
                                                                        69660000
  << Move the data to the user's dst >>                                 69665000
                                                                        69670000
  if count > 0 then                                            <<04434>>69675000
    begin                                                      <<04434>>69680000
      mtds(dst'num,address,env'status'info,count);             <<04434>>69685000
    end;                                                       <<04434>>69690000
                                                                        69695000
                                                                        69700000
  << Adjust the transfer log count >>                                   69705000
                                                                        69710000
  if count'was'negative then                                            69715000
    begin                                                               69720000
      transfer'log := -(count to'byte);                                 69725000
    end                                                                 69730000
  else                                                                  69735000
    begin                                                               69740000
      transfer'log := count;                                            69745000
    end;                                                                69750000
                                                                        69755000
                                                                        69760000
  << Since we are returning the current available status, >>            69765000
  << clear the status'received and status'reported bits   >>            69770000
  << in cb'info.                                          >>            69775000
                                                                        69780000
  cb'info(status'received).env'stat'bit := clear'bit;                   69785000
  cb'info(status'reported).env'stat'bit := clear'bit;                   69790000
                                                                        69795000
                                                                        69800000
  << Set the completion code >>                                         69805000
                                                                        69810000
  return'status := no'errors;                                           69815000
                                                                        69820000
end;  << of procedure b08'buffered'env'status >>                        69825000
                                                                        69830000
$PAGE "PROCEDURE:  B08'AVAILABLE'STATUS"                                69835000
double procedure b08'available'status(cb'info, dst'num,                 69840000
                                      address, count    );              69845000
                                                                        69850000
  value                               cb'info, dst'num,                 69855000
                                      address, count     ;              69860000
                                                                        69865000
  integer pointer                     cb'info            ;              69870000
                                                                        69875000
  integer                                      dst'num,                 69880000
                                      address, count     ;              69885000
                                                                        69890000
  option privileged, uncallable                          ;              69895000
                                                                        69900000
                                                                        69905000
                                                                        69910000
COMMENT                                                                 69915000
                                                                        69920000
  PURPOSE:                                                              69925000
                                                                        69930000
    This procedure will move the status'received word of                69935000
    cb'info to an array provided by the caller.  This word is           69940000
    a bit map indicating which types of status have been re-            69945000
    ceived by the logical driver and are available for the              69950000
    caller to read.                                                     69955000
                                                                        69960000
                                                                        69965000
  INPUT PARAMETERS:                                                     69970000
                                                                        69975000
    CB'INFO, which points to the control block information              69980000
      area of the logical driver.  This area contains the               69985000
      status'received word, along with other global informa-            69990000
      tion of the logical driver.                                       69995000
                                                                        70000000
    DST'NUM, a data segment number where the destination array          70005000
      is located.  This array must be at least one word long            70010000
      (a longer array would provide future expandibility and            70015000
      is recommended).                                                  70020000
                                                                        70025000
    ADDRESS, the offset within the target data segment where            70030000
      the destination array begins.                                     70035000
                                                                        70040000
    COUNT, the number of words (if positive) or bytes (if neg-          70045000
      ative) to move from the CIPER data segment to the                 70050000
      caller's data segment.  This must be at least one word            70055000
      or an error return will be made and no data will be               70060000
      moved.                                                            70065000
                                                                        70070000
                                                                        70075000
  OUTPUT PARAMETERS:                                                    70080000
                                                                        70085000
    B08'AVAILABLE'STATUS, which is a double word                        70090000
      function return.  Word 0 of this return is the comple-            70095000
      tion status of the call.  Word 1 is the transfer log,             70100000
      returned in the same sense as the input parameter count           70105000
      (+ for words, - for bytes).                                       70110000
                                                                        70115000
                                                                        70120000
  SIDE-EFFECTS:                                                         70125000
                                                                        70130000
    None.                                                               70135000
                                                                        70140000
                                                                        70145000
  SPECIAL CONSIDERATIONS:                                               70150000
                                                                        70155000
    None.                                                               70160000
                                                                        70165000
                                                                        70170000
  CHANGE HISTORY:                                                       70175000
                                                                        70180000
    As issued.                                                          70185000
                                                                        70190000
                                                                        70195000
;                                                                       70200000
$PAGE "PROCEDURE:  B08'AVAILABLE'STATUS -- LOCAL VARIABLES"             70205000
begin                                                                   70210000
                                                                        70215000
  << Function return sub-parameters: >>                                 70220000
                                                                        70225000
  double                                                                70230000
                                                                        70235000
    return'information            = b08'available'status                70240000
                                                                        70245000
  ;                                                                     70250000
                                                                        70255000
                                                                        70260000
  integer                                                               70265000
                                                                        70270000
    return'status                 = b08'available'status                70275000
      << Completion status for call >>                                  70280000
                                                                        70285000
   ,transfer'log                  = b08'available'status + 1            70290000
      << Count of data moved to caller >>                               70295000
                                                                        70300000
  ;                                                                     70305000
                                                                        70310000
                                                                        70315000
  declare'move'to'data'segment;                                         70320000
$PAGE "PROCEDURE:  B08'AVAILABLE'STATUS -- PROCEDURE BODY"              70325000
                                                                        70330000
  << If the caller did not give us enough room - at least >>            70335000
  << one word -- return with an invalid request status.   >>            70340000
                                                                        70345000
  if -1 <= count <= 0 then                                              70350000
    begin                                                               70355000
      return'status := invalid'request;                                 70360000
      transfer'log := 0;                                                70365000
    end                                                                 70370000
  else                                                                  70375000
    begin                                                               70380000
      mtds(dst'num, address, cb'info(status'received), 1);              70385000
      return'status := successful;                                      70390000
      transfer'log := if count < 0 then -2 else 1;                      70395000
    end;                                                                70400000
                                                                        70405000
end;  << of procedure b08'available'status >>                           70410000
                                                                        70415000
$PAGE "PROCEDURE:  B08'DEVICE'CLOSE"                                    70420000
double procedure b08'device'close(cb'info);                             70425000
                                                                        70430000
  value                           cb'info ;                             70435000
                                                                        70440000
  integer pointer                 cb'info ;                             70445000
                                                                        70450000
  option privileged, uncallable           ;                             70455000
                                                                        70460000
                                                                        70465000
                                                                        70470000
COMMENT                                                                 70475000
                                                                        70480000
  PURPOSE:                                                              70485000
                                                                        70490000
    This procedure will tidy up all device processing prior             70495000
    to deallocating the device.  This includes such things as           70500000
    sending all pending record buffers, ending any active jobs,         70505000
    processing incoming status, etc.  When all data transfers           70510000
    are complete, the transport service will be close with a            70515000
    transport'deallocate command.                                       70520000
                                                                        70525000
                                                                        70530000
  INPUT PARAMETERS:                                                     70535000
                                                                        70540000
    CB'INFO, which points to the Level 7 control block infor-           70545000
      mation area of the appropriate logical device.                    70550000
                                                                        70555000
                                                                        70560000
  OUTPUT PARAMETERS:                                                    70565000
                                                                        70570000
    B08'DEVICE'CLOSE, which is a double word function return.           70575000
      Word 0 is the completion status of the call.                      70580000
      Word 1 is the transfer log of data moved from the caller          70585000
      to the device (currently always zero).                            70590000
                                                                        70595000
                                                                        70600000
  SIDE-EFFECTS:                                                         70605000
                                                                        70610000
    All intra-job information will be set to an initial state.          70615000
                                                                        70620000
                                                                        70625000
  SPECIAL CONSIDERATIONS:                                               70630000
                                                                        70635000
    When called, DB must be set to the base of the CIPER data           70640000
    segment.                                                            70645000
                                                                        70650000
                                                                        70655000
  CHANGE HISTORY:                                                       70660000
                                                                        70665000
    As issued.                                                          70670000
                                                                        70675000
;                                                                       70680000
$PAGE "PROCEDURE:  B08'DEVICE'CLOSE -- LOCAL VARIABLES"                 70685000
begin                                                                   70690000
                                                                        70695000
  << Completion status sub-parameters >>                                70700000
                                                                        70705000
  double                                                                70710000
                                                                        70715000
    return'information            = b08'device'close                    70720000
                                                                        70725000
  ;                                                                     70730000
                                                                        70735000
                                                                        70740000
  integer                                                               70745000
                                                                        70750000
    return'status                 = b08'device'close                    70755000
      << Contains completion code for call >>                           70760000
                                                                        70765000
   ,transfer'log                  = b08'device'close + 1                70770000
      << Total count of user data moved >>                              70775000
                                                                        70780000
  ;                                                                     70785000
                                                                        70790000
                                                                        70795000
  integer pointer                                                       70800000
                                                                        70805000
    o'r'control                                                         70810000
      << pointer to control portion of record buffer area >>            70815000
                                                                        70820000
   ,control'table                                                       70825000
      << pointer to control table for this ldev >>                      70830000
                                                                        70835000
  ;                                                                     70840000
$PAGE "PROCEDURE:  B08'DEVICE'CLOSE -- PROCEDURE BODY"                  70845000
  << First, buffer up the escape sequence for the device >>             70850000
  << close command (conditional top of form).            >>             70855000
                                                                        70860000
  return'information :=                                                 70865000
      b08'write'data( cb'info,                                          70870000
                      0,                                                70875000
                      0,                                                70880000
                      device'close,                                     70885000
                      0,                                                70890000
                      0,                                                70895000
                      0,                                                70900000
                      0,                                                70905000
                      user'data'with'mask,                              70910000
                      true,                                             70915000
                      true                  );                          70920000
                                                                        70925000
                                                                        70930000
  << If that was successful, flush out any remaining data. >>           70935000
  << This can be done two ways, by ending an active job,   >>           70940000
  << or just sending any pending record buffers.           >>           70945000
                                                                        70950000
  if return'status.general = successful then                            70955000
    begin                                                               70960000
                                                                        70965000
      if logical( cb'info(job'active) ) then                            70970000
        begin                                                           70975000
                                                                        70980000
          return'information :=                                         70985000
              b08'end'job( cb'info, 0, 0, 0, 0 );                       70990000
                                                                        70995000
        end                                                             71000000
      else                                                              71005000
        begin                                                           71010000
                                                                        71015000
          << No job active, so send any data directly. >>               71020000
                                                                        71025000
          @o'r'control := cb'info(o'r'base)                             71030000
                        + cb'info(cds'area'base);                       71035000
                                                                        71040000
          if logical( o'r'control(active) ) then                        71045000
            begin                                                       71050000
                                                                        71055000
              return'status := cpr'send'record( cb'info,                71060000
                                                o'r'control );          71065000
                                                                        71070000
            end;                                                        71075000
        end;                                                            71080000
    end;                                                                71085000
                                                                        71090000
                                                                        71095000
  << Close off the transport service >>                                 71100000
                                                                        71105000
  @control'table := cb'info(ct'ptr);                                    71110000
                                                                        71115000
  b08'network'protocol( control'table,                                  71120000
                        transport'deallocate,                           71125000
                        0,                                              71130000
                        0,                                              71135000
                        cb'info(ciper'dst),                             71140000
                        cb'info(logical'device)  );                     71145000
                                                                        71150000
                                                                        71155000
  << Mark the device as available >>                                    71160000
                                                                        71165000
  cb'info(device'allocated) := free;                                    71170000
                                                                        71175000
  cb'info(file'open'count) := 0;                                        71180000
                                                                        71185000
                                                                        71190000
end;  << of procedure b08'device'close >>                               71195000
                                                                        71200000
$PAGE "PROCEDURE:  B08'FILE'OPEN"                                       71205000
double procedure b08'file'open(cb'info);                                71210000
                                                                        71215000
  value                        cb'info ;                                71220000
                                                                        71225000
  integer pointer              cb'info ;                                71230000
                                                                        71235000
  option privileged, uncallable        ;                                71240000
                                                                        71245000
                                                                        71250000
COMMENT                                                                 71255000
                                                                        71260000
  PURPOSE:                                                              71265000
                                                                        71270000
    This procedure will perform all functions necessary to              71275000
    complete a file open call.  This includes allocating the            71280000
    transport service, buffering a conditional top of form              71285000
    command for the 2608B, and if this is the first fopen,              71290000
    also initializing certain information in the control block          71295000
    information area.                                                   71300000
                                                                        71305000
                                                                        71310000
  INPUT PARAMETERS:                                                     71315000
                                                                        71320000
    CB'INFO, which points to the control block information              71325000
      area for the logical driver.  This is a global area for           71330000
                                                                        71335000
                                                                        71340000
  OUTPUT PARAMETERS:                                                    71345000
                                                                        71350000
    B08'FILE'OPEN, a double word function return, which is de-          71355000
      fined as follows:                                                 71360000
          word 0 -- completion status of call                           71365000
          word 1 -- transfer log of data moved from caller to           71370000
                    peripheral.                                         71375000
                                                                        71380000
                                                                        71385000
  SIDE-EFFECTS:                                                         71390000
                                                                        71395000
    This procedure will pass a transport'open command down to           71400000
    the transport service.  A conditional top of form escape            71405000
    sequence will be buffered for the 2608B.  If this is the            71410000
    first fopen call from the user, certain global information          71415000
    will be initialized.                                                71420000
                                                                        71425000
                                                                        71430000
  SPECIAL CONSIDERATIONS:                                               71435000
                                                                        71440000
    When called, DB must be set to the base of the CIPER data           71445000
    segment.                                                            71450000
                                                                        71455000
                                                                        71460000
  CHANGE HISTORY:                                                       71465000
                                                                        71470000
    As issued.                                                          71475000
                                                                        71480000
                                                                        71485000
;                                                                       71490000
$PAGE "PROCEDURE:  B08'FILE'OPEN -- LOCAL VARIABLES"                    71495000
begin                                                                   71500000
                                                                        71505000
  << Completion status subparameters: >>                                71510000
                                                                        71515000
  double                                                                71520000
                                                                        71525000
    return'information            = b08'file'open                       71530000
                                                                        71535000
  ;                                                                     71540000
                                                                        71545000
                                                                        71550000
  integer                                                               71555000
                                                                        71560000
    return'status                 = b08'file'open                       71565000
      << Completion status of call >>                                   71570000
                                                                        71575000
   ,transfer'log                  = b08'file'open + 1                   71580000
      << Count of data moved from caller to device >>                   71585000
                                                                        71590000
  ;                                                                     71595000
                                                                        71600000
                                                                        71605000
  << Control table information: >>                                      71610000
                                                                        71615000
  integer pointer                                                       71620000
                                                                        71625000
    control'table                                                       71630000
      << Points to the control table for a particular ldev >>           71635000
                                                                        71640000
  ;                                                                     71645000
                                                               <<04434>>71650000
                                                               <<04434>>71655000
  << Record buffer pointer >>                                  <<04434>>71660000
                                                               <<04434>>71665000
  integer pointer                                              <<04434>>71670000
                                                               <<04434>>71675000
    o'r'control                                                <<04434>>71680000
                                                               <<04434>>71685000
  ;                                                            <<04434>>71690000
$PAGE "PROCEDURE:  B08'FILE'OPEN -- PROCEDURE BODY"                     71695000
                                                                        71700000
  << Initialize the control table pointer. >>                           71705000
                                                                        71710000
  @control'table := cb'info(ct'ptr);                                    71715000
                                                                        71720000
                                                                        71725000
  << Call the transport service with an allocation command. >>          71730000
                                                                        71735000
  return'information :=                                                 71740000
    b08'network'protocol( control'table,                                71745000
                          transport'open,                               71750000
                          0,                                            71755000
                          0,                                            71760000
                          control'table(ct'cds'dst'num),                71765000
                          cb'info(logical'device)        );             71770000
                                                                        71775000
  if return'status.general = successful then                            71780000
    begin                                                               71785000
                                                                        71790000
      << The transport opened without error, so buffer up >>            71795000
      << conditional top of form command.                 >>            71800000
                                                                        71805000
      return'information :=                                             71810000
        b08'write'data( cb'info,                                        71815000
                        0,                                              71820000
                        0,                                              71825000
                        file'open,                                      71830000
                        0,                                              71835000
                        0,                                              71840000
                        0,                                              71845000
                        0,                                              71850000
                        user'data'with'mask,                            71855000
                        true,                                           71860000
                        true                   );                       71865000
                                                                        71870000
      if return'status.general = successful then                        71875000
        begin                                                           71880000
                                                                        71885000
          << Now see if this is the first fopen call.  If >>            71890000
          << it is, then certain information should be    >>            71895000
          << initialized.                                 >>            71900000
                                                                        71905000
          cb'info(file'open'count) := cb'info(file'open'count)          71910000
                                    + 1;                                71915000
                                                                        71920000
          if not logical( cb'info(device'allocated) ) then              71925000
            begin                                                       71930000
                                                                        71935000
              cb'info(device'allocated) := in'use;                      71940000
                                                                        71945000
              << Disable any notification of incoming status >>         71950000
              << information reports.                        >>         71955000
                                                                        71960000
              cb'info(status'enabled) := 0;                             71965000
                                                               <<04434>>71970000
                                                               <<04434>>71975000
              << Send the fopen record, ignoring any errors >> <<04434>>71980000
              << (no previous data has been lost)           >> <<04434>>71985000
                                                               <<04434>>71990000
              @o'r'control := cb'info(o'r'base)                <<04434>>71995000
                            + cb'info(cds'area'base);          <<04434>>72000000
                                                               <<04434>>72005000
              return'status := cpr'send'record( cb'info        <<04434>>72010000
                                               ,o'r'control ); <<04434>>72015000
                                                               <<04434>>72020000
              if return'status <> successful then              <<04434>>72025000
                begin                                          <<04434>>72030000
                                                               <<04434>>72035000
                  if return'status = pf'error then             <<04434>>72040000
                    begin                                      <<04434>>72045000
                      return'status := successful;             <<04434>>72050000
                    end;                                       <<04434>>72055000
                                                               <<04434>>72060000
                end;                                           <<04434>>72065000
                                                                        72070000
            end;                                                        72075000
                                                                        72080000
        end;                                                            72085000
                                                                        72090000
    end;                                                                72095000
                                                                        72100000
end;  << of procedure b08'file'open >>                                  72105000
                                                                        72110000
$PAGE "PROCEDURE:  B08'END'BLOCK"                                       72115000
double procedure b08'end'block(cb'info);                                72120000
                                                                        72125000
  value                        cb'info ;                                72130000
                                                                        72135000
  integer pointer              cb'info ;                                72140000
                                                                        72145000
  option privileged, uncallable        ;                                72150000
                                                                        72155000
                                                                        72160000
COMMENT                                                                 72165000
                                                                        72170000
  PURPOSE:                                                              72175000
                                                                        72180000
    This procedure will mark an existing output data record             72185000
    as the end of block, and then send the record to the                72190000
    peripheral.  If no such record exists, then a new record            72195000
    will be created and sent.                                           72200000
                                                                        72205000
                                                                        72210000
  INPUT PARAMETERS:                                                     72215000
                                                                        72220000
    CB'INFO, which points to the control block information              72225000
      area of the logical driver.  This area is the global              72230000
      information area of the driver, and contains pointers             72235000
      to the various record buffer areas, etc.                          72240000
                                                                        72245000
                                                                        72250000
  OUTPUT PARAMETERS:                                                    72255000
                                                                        72260000
    B08'END'BLOCK, which is a double word function return.              72265000
      Word 0 indicates the completion status of the call.               72270000
      Word 1 is the transfer log of data moved from the caller          72275000
      to the peripheral.  For this procedure, transfer log is           72280000
      always zero.                                                      72285000
                                                                        72290000
                                                                        72295000
  SIDE-EFFECTS:                                                         72300000
                                                                        72305000
    Any pending output data record will be sent to the device.          72310000
                                                                        72315000
                                                                        72320000
  SPECIAL CONSIDERATIONS:                                               72325000
                                                                        72330000
    None.                                                               72335000
                                                                        72340000
                                                                        72345000
  CHANGE HISTORY:                                                       72350000
                                                                        72355000
    As issued.                                                          72360000
                                                                        72365000
                                                                        72370000
;                                                                       72375000
$PAGE "PROCEDURE:  B08'END'BLOCK -- LOCAL VARIABLES"                    72380000
begin                                                                   72385000
                                                                        72390000
  << Function return sub-parameter definitions: >>                      72395000
                                                                        72400000
  double                                                                72405000
                                                                        72410000
    return'information            = b08'end'block                       72415000
                                                                        72420000
  ;                                                                     72425000
                                                                        72430000
                                                                        72435000
  integer                                                               72440000
                                                                        72445000
    return'status                 = b08'end'block                       72450000
      << contains the completion status of the call >>                  72455000
                                                                        72460000
   ,transfer'log                  = b08'end'block + 1                   72465000
      << Count of data moved from caller to peripheral >>               72470000
                                                                        72475000
  ;                                                                     72480000
                                                                        72485000
                                                                        72490000
  << Output record pointers: >>                                         72495000
                                                                        72500000
  integer pointer                                                       72505000
                                                                        72510000
    o'r'control                                                         72515000
      << points to control portion of record buffer area >>             72520000
                                                                        72525000
   ,o'r'data                                                            72530000
      << points to data portion of record buffer area >>                72535000
                                                                        72540000
  ;                                                                     72545000
$PAGE "PROCEDURE:  B08'END'BLOCK -- PROCEDURE BODY"                     72550000
                                                                        72555000
  << First, initialize the record buffer pointers >>                    72560000
                                                                        72565000
  @o'r'control := cb'info(o'r'base)                                     72570000
                + cb'info(cds'area'base);                               72575000
                                                                        72580000
  @o'r'data := @o'r'control + o'r'control(start);                       72585000
                                                                        72590000
                                                                        72595000
  << If there is not any pending record, we will have to >>             72600000
  << build a fresh record to mark as end of block.       >>             72605000
                                                                        72610000
  if not logical( o'r'control(active) ) then                            72615000
    begin                                                               72620000
      b08'build'header( o'r'control,                                    72625000
                        lgl'write,                                      72630000
                        cb'info(o'r'data'type) );                       72635000
                                                                        72640000
    end;                                                                72645000
                                                                        72650000
                                                                        72655000
  << Mark the record as end of block >>                                 72660000
                                                                        72665000
  o'r'data(eob'flag) := set'bit;                                        72670000
                                                                        72675000
                                                                        72680000
  << Send the record to the peripheral >>                               72685000
                                                                        72690000
  return'status := cpr'send'record(cb'info, o'r'control);               72695000
                                                                        72700000
                                                                        72705000
  << The return status of cpr'send'record will serve as >>              72710000
  << the completion status of this call, so just return >>              72715000
                                                                        72720000
end;  << of procedure b08'end'block >>                                  72725000
                                                                        72730000
$PAGE "PROCEDURE:  B08'START'BLOCK"                                     72735000
double procedure b08'start'block(cb'info,                               72740000
                                 label'upper'word,                      72745000
                                 label'lower'word );                    72750000
                                                                        72755000
  value                          cb'info,                               72760000
                                 label'upper'word,                      72765000
                                 label'lower'word  ;                    72770000
                                                                        72775000
  integer pointer                cb'info             ;                  72780000
                                                                        72785000
  integer                        label'upper'word,                      72790000
                                 label'lower'word  ;                    72795000
                                                                        72800000
  option privileged, uncallable                    ;                    72805000
                                                                        72810000
                                                                        72815000
COMMENT                                                                 72820000
                                                                        72825000
  PURPOSE:                                                              72830000
                                                                        72835000
    This procedure will create a new output data record, and            72840000
    mark it as the start of a new block, and fill in the block          72845000
    label.  The block number is obtained from the parm1 and             72850000
    parm2 the caller passed in.                                         72855000
                                                                        72860000
    If an output data record already exists, it will be marked          72865000
    as end of block and sent to the peripheral before the new           72870000
    record is created.                                                  72875000
                                                                        72880000
                                                                        72885000
  INPUT PARAAMETERS:                                                    72890000
                                                                        72895000
    CB'INFO, which points to the control block information              72900000
      area of the logical driver (level 7).  This information           72905000
      block contains pointers to the record buffer areas, as            72910000
      well as other global information for the logical driver.          72915000
                                                                        72920000
    BLOCK'LABEL'WORD'1, which is the upper word of the block            72925000
      label to be created.  It, together with the lower word            72930000
      of the block label, form a double word block number that          72935000
      the user can tag data with in the event recovery is ne-           72940000
      cessary.  Refer to the CIPER working standard for more            72945000
      detail.                                                           72950000
                                                                        72955000
    BLOCK'LABEL'WORD'2, which is the lower word of the double           72960000
      word block number.                                                72965000
                                                                        72970000
                                                                        72975000
  OUTPUT PARAMETERS:                                                    72980000
                                                                        72985000
    B08'START'BLOCK, which is a double word function return             72990000
      that conveys the completion status of the call.  Word 0           72995000
      is the completion status, word 1 is the transfer log              73000000
      (currently reserved).                                             73005000
                                                                        73010000
                                                                        73015000
  SIDE-EFFECTS:                                                         73020000
                                                                        73025000
    This procedure will cause transmission of any pending data          73030000
    record, if any exists.  A new output data record will be            73035000
    created, with the appropriate header information and block          73040000
    label in place.                                                     73045000
                                                                        73050000
                                                                        73055000
  SPECIAL CONSIDERATIONS:                                               73060000
                                                                        73065000
    None.                                                               73070000
                                                                        73075000
                                                                        73080000
  CHANGE HISTORY:                                                       73085000
                                                                        73090000
    As issued.                                                          73095000
                                                                        73100000
                                                                        73105000
;                                                                       73110000
$PAGE "PROCEDURE:  B08'START'BLOCK -- LOCAL VARIABLES"                  73115000
begin                                                                   73120000
                                                                        73125000
  << Function return information >>                                     73130000
                                                                        73135000
  double                                                                73140000
                                                                        73145000
    return'information            = b08'start'block                     73150000
      << Completion status for call >>                                  73155000
                                                                        73160000
  ;                                                                     73165000
                                                                        73170000
                                                                        73175000
  integer                                                               73180000
                                                                        73185000
    return'status                 = b08'start'block                     73190000
      << Completion code returned to caller >>                          73195000
                                                                        73200000
   ,transfer'log                  = b08'start'block + 1                 73205000
      << Count of data moved from caller to peripheral >>               73210000
                                                                        73215000
  ;                                                                     73220000
                                                                        73225000
                                                                        73230000
  << Output record pointers >>                                          73235000
                                                                        73240000
  integer pointer                                                       73245000
                                                                        73250000
    o'r'control                                                         73255000
      << Points to control portion of record buffer area >>             73260000
                                                                        73265000
   ,o'r'data                                                            73270000
      << Points to data portion of record buffer area >>                73275000
                                                                        73280000
  ;                                                                     73285000
$PAGE "PROCEDURE:  B08'START'BLOCK -- PROCEDURE BODY"                   73290000
                                                                        73295000
  << Initialize the record control pointer >>                           73300000
                                                                        73305000
  @o'r'control := cb'info(o'r'base)                                     73310000
                + cb'info(cds'area'base);                               73315000
                                                                        73320000
                                                                        73325000
  << Set up the pointer to the data portion of the record >>            73330000
                                                                        73335000
  @o'r'data := @o'r'control + o'r'control(start);                       73340000
                                                                        73345000
                                                                        73350000
  << If a record is currently active, we have to mark it >>             73355000
  << as the end of block and send it to the peripheral.  >>             73360000
                                                                        73365000
  if logical( o'r'control(active) ) then                                73370000
    begin                                                               73375000
                                                                        73380000
      return'information := b08'end'block(cb'info);                     73385000
                                                                        73390000
      if return'status.general <> successful then return;               73395000
                                                                        73400000
    end;                                                                73405000
                                                                        73410000
                                                                        73415000
  << Now that we have a clean record buffer to work with, >>            73420000
  << build a record header for it.                        >>            73425000
                                                                        73430000
  b08'build'header( o'r'control,                                        73435000
                    lgl'write,                                          73440000
                    user'data'with'mask );                              73445000
                                                                        73450000
                                                                        73455000
  << Set the start of block bit in the record header >>                 73460000
                                                                        73465000
  o'r'data(sob'flag) := set'bit;                                        73470000
                                                                        73475000
                                                                        73480000
  << Put the block label length in next >>                              73485000
                                                                        73490000
  o'r'data(parm'byte'1) := block'label'length;                          73495000
  o'r'data(parm'byte'2) := 0;  << currently reserved >>                 73500000
                                                                        73505000
                                                                        73510000
  << Now put in the block number as the caller gave it >>               73515000
                                                                        73520000
  o'r'data(3) := label'upper'word;                                      73525000
  o'r'data(4) := label'lower'word;                                      73530000
                                                                        73535000
                                                                        73540000
  << Update the record control information >>                           73545000
                                                                        73550000
  o'r'control(current'position) :=                                      73555000
      o'r'control(current'position) + block'label'length;               73560000
                                                                        73565000
  o'r'control(current'length) := o'r'control(current'length)            73570000
                               + block'label'length;                    73575000
                                                                        73580000
                                                                        73585000
  << Set a good completion status >>                                    73590000
                                                                        73595000
  return'status := successful;                                          73600000
                                                                        73605000
                                                                        73610000
end;  << of procedure b08'start'block >>                                73615000
                                                                        73620000
$PAGE "PROCEDURE:  B08'SILENT'RUN"                                      73625000
double procedure b08'silent'run(cb'info, dst'num, address,              73630000
                                count, flags              );            73635000
                                                                        73640000
  value                         cb'info, dst'num, address,              73645000
                                count, flags               ;            73650000
                                                                        73655000
  integer pointer               cb'info                    ;            73660000
                                                                        73665000
  integer                                dst'num, address,              73670000
                                count, flags               ;            73675000
                                                                        73680000
  option privileged, uncallable                            ;            73685000
                                                                        73690000
                                                                        73695000
COMMENT                                                                 73700000
                                                                        73705000
   PURPOSE:                                                             73710000
                                                                        73715000
    This procedure will send the BEGIN SILENT RUN command               73720000
    record to the 2608S.  The information in this record is             73725000
    passed in by the caller, and consists of block information,         73730000
    checkpoint numbers, and peripheral status information that          73735000
    the 2608S needs to enter the silent run recovery mode.              73740000
                                                                        73745000
                                                                        73750000
  INPUT PARAMETERS:                                                     73755000
                                                                        73760000
    CB'INFO, which points to the control block information              73765000
      area of the logical driver.                                       73770000
                                                                        73775000
    DST'NUM, which is the data segment number of the DST where          73780000
      the silent run recovery block will be moved from.  Note:          73785000
      this must be a stack or extra data segment, the code does         73790000
      not support system buffers at this time.                          73795000
                                                                        73800000
    ADDRESS, which is the offset in dst'num where the silent            73805000
      run recovery block begins.                                        73810000
                                                                        73815000
    COUNT, which is the size of the silent run recovery block.          73820000
      If count is positive, it specifies words.  If count is            73825000
      negative, it specifies bytes.                                     73830000
                                                                        73835000
    FLAGS, which are the request dependent flags passed by              73840000
      attachio to the logical driver.  The bit specifying sys-          73845000
      tem buffers is in flags, and is checked to make sure the          73850000
      caller is not using system buffers.                               73855000
                                                                        73860000
                                                                        73865000
  OUTPUT PARAMETERS:                                                    73870000
                                                                        73875000
    B08'SILENT'RUN, a double word function return.  Word 0 is           73880000
      the completion status of the call.  Word 1 is the trans-          73885000
      fer log of information moved from the caller's area into          73890000
      the silent run command record.  The transfer log is re-           73895000
      turned in the same sense as the input parameter count.            73900000
                                                                        73905000
                                                                        73910000
  SIDE-EFFECTS:                                                         73915000
                                                                        73920000
    If the peripheral accepts the silent run command record,            73925000
    it will be placed in the silent run mode.  Refer to the             73930000
    CIPER document for details of this mode of operation.               73935000
                                                                        73940000
                                                                        73945000
  SPECIAL CONSIDERATIONS:                                               73950000
                                                                        73955000
    None.                                                               73960000
                                                                        73965000
                                                                        73970000
  CHANGE HISTORY:                                                       73975000
                                                                        73980000
    As issued.                                                          73985000
                                                                        73990000
;                                                                       73995000
$PAGE "PROCEDURE:  B08'SILENT'RUN -- LOCAL VARIABLES"                   74000000
begin                                                                   74005000
                                                                        74010000
  << Function return variables: >>                                      74015000
                                                                        74020000
  double                                                                74025000
                                                                        74030000
    return'information            = b08'silent'run                      74035000
                                                                        74040000
  ;                                                                     74045000
                                                                        74050000
                                                                        74055000
  integer                                                               74060000
                                                                        74065000
    return'status                 = b08'silent'run                      74070000
      << Completion status of procedure call >>                         74075000
                                                                        74080000
   ,transfer'log                  = b08'silent'run + 1                  74085000
      << Transfer count of data moved from caller to device >>          74090000
                                                                        74095000
  ;                                                                     74100000
                                                                        74105000
                                                                        74110000
  << Output record control pointers: >>                                 74115000
                                                                        74120000
  integer pointer                                                       74125000
                                                                        74130000
    o'r'control                                                         74135000
      << Points to control portion of record buffer area >>             74140000
                                                                        74145000
   ,o'r'data                                                            74150000
      << Points to base of data portion of record buffer >>             74155000
      << area.                                           >>             74160000
                                                                        74165000
  ;                                                                     74170000
                                                                        74175000
                                                                        74180000
  << Counters of how much to move, how much has been moved, >>          74185000
  << the total size of the silent run recovery block, etc.  >>          74190000
                                                                        74195000
  integer                                                               74200000
                                                                        74205000
    what'fits                                                           74210000
      << Size of the available data area of the output >>               74215000
      << record, in words                              >>               74220000
                                                                        74225000
   ,word'count                                                          74230000
      << Size of the silent run recovery block, to the >>               74235000
      << nearest word                                  >>               74240000
                                                                        74245000
   ,move'count                                                          74250000
      << Amount to be moved per record from the caller's >>             74255000
      << data area                                       >>             74260000
                                                                        74265000
   ,total'moved                                                         74270000
      << tally of how many words have been moved into >>                74275000
      << output record(s)                             >>                74280000
                                                                        74285000
  ;                                                                     74290000
                                                                        74295000
                                                                        74300000
  logical                                                               74305000
                                                                        74310000
    odd'count                                                           74315000
      << Keeps track of the fact that a negative count may >>           74320000
      << be an odd number of bytes, which causes some extra >>          74325000
      << manipulation on our part.                          >>          74330000
                                                                        74335000
  ;                                                                     74340000
  declare'move'from'data'segment;                                       74345000
                                                                        74350000
$PAGE "PROCEDURE:  B08'SILENT'RUN -- PROCEDURE BODY"                    74355000
  << If the caller specified system buffers as the source >>            74360000
  << of the data, return with an illegal function error.  >>            74365000
                                                                        74370000
  if logical( flags.system'buffers ) then                               74375000
    begin                                                               74380000
      return'status := invalid'request;                                 74385000
      return;                                                           74390000
    end;                                                                74395000
                                                                        74400000
                                                                        74405000
  << Otherwise, set up the pointers to the output record   >>           74410000
  << buffer area.  If there was any residual data pending  >>           74415000
  << in that buffer, it can be ignored, because the silent >>           74420000
  << run command essentially starts from scratch.          >>           74425000
                                                                        74430000
  @o'r'control := cb'info(o'r'base) + cb'info(cds'area'base);           74435000
                                                                        74440000
  @o'r'data := o'r'control(start) + @o'r'control;                       74445000
                                                                        74450000
                                                                        74455000
  << Now convert the caller's count into a word count >>                74460000
                                                                        74465000
  if count < 0 then                                                     74470000
    begin                                                               74475000
      word'count := (-count+1) to'word;                                 74480000
      odd'count := logical( count.bit'15 );                             74485000
    end                                                                 74490000
  else                                                                  74495000
    begin                                                               74500000
      word'count := count;                                              74505000
      odd'count := false;                                               74510000
    end;                                                                74515000
                                                                        74520000
                                                                        74525000
  << Build the initial record header and set the start of >>            74530000
  << block bit                                            >>            74535000
                                                                        74540000
  b08'build'header( o'r'control,                                        74545000
                    lgl'silent'run,                                     74550000
                    no'data'type'used );                                74555000
                                                                        74560000
  o'r'data(sob'flag) := set'bit;                                        74565000
                                                                        74570000
                                                                        74575000
  << Calculate how many words will fit into what is left >>             74580000
  << of the record buffer                                >>             74585000
                                                                        74590000
  what'fits := (o'r'control(maximum'size)                               74595000
                - o'r'control(current'length)) to'word;                 74600000
                                                                        74605000
                                                                        74610000
  << Now loop, filling the record, sending it to the device, >>         74615000
  << until the word'count is exhausted.  On the last record, >>         74620000
  << the end of block bit should be set.                     >>         74625000
                                                                        74630000
  do                                                                    74635000
    begin                                                               74640000
                                                                        74645000
      << Determine how much of the request to move into  >>             74650000
      << the record.                                     >>             74655000
                                                                        74660000
      move'count := if word'count > what'fits                           74665000
          then what'fits                                                74670000
          else word'count;                                              74675000
                                                                        74680000
      << Reduce the requested count by the amount that will >>          74685000
      << be moved this pass.                                >>          74690000
                                                                        74695000
      word'count := word'count - move'count;                            74700000
                                                                        74705000
      << Move the data from the caller's area into the >>               74710000
      << record buffer area.                           >>               74715000
                                                                        74720000
      mfds(o'r'data( o'r'data(header'length) to'word),                  74725000
           dst'num,                                                     74730000
           address,                                                     74735000
        MOVE'COUNT);                                           <<07425>>74740000
                                                                        74745000
                                                                        74750000
      << Adjust the source address to reflect what has >>               74755000
      << been moved                                    >>               74760000
                                                                        74765000
   ADDRESS := ADDRESS + MOVE'COUNT;                            <<07425>>74770000
                                                                        74775000
                                                                        74780000
      << Adjust the record control information >>                       74785000
                                                                        74790000
      o'r'control(current'length) :=                                    74795000
          o'r'control(current'length) + (move'count to'byte);           74800000
                                                                        74805000
                                                                        74810000
      << If the word'count is exhausted, this will be the >>            74815000
      << last record, so set the end of block bit.        >>            74820000
                                                                        74825000
      if word'count = 0 then                                            74830000
        begin                                                           74835000
          o'r'data(eob'flag) := set'bit;                                74840000
                                                                        74845000
          if odd'count then                                             74850000
            begin                                                       74855000
              o'r'control(current'length) :=                            74860000
                  o'r'control(current'length) - 1;                      74865000
            end;                                                        74870000
        end;                                                            74875000
                                                                        74880000
                                                                        74885000
      << Send the record to the peripheral >>                           74890000
                                                                        74895000
      return'status := cpr'send'record(cb'info, o'r'control);           74900000
                                                                        74905000
      if return'status = successful then                                74910000
        begin                                                           74915000
          if word'count <> 0 then                                       74920000
            begin                                                       74925000
              b08'build'header( o'r'control,                            74930000
                                lgl'silent'run,                         74935000
                                no'data'type'used );                    74940000
            end;                                                        74945000
                                                                        74950000
          total'moved := total'moved + move'count;                      74955000
                                                                        74960000
        end                                                             74965000
      else                                                              74970000
        begin                                                           74975000
          << Force the word count to zero so we will exit >>            74980000
          << with an error condition.                     >>            74985000
                                                                        74990000
          word'count := 0;                                              74995000
                                                                        75000000
        end;                                                            75005000
                                                                        75010000
    end                                                                 75015000
  until word'count = 0;                                                 75020000
                                                                        75025000
                                                                        75030000
  << Adjust the transfer'log to reflect the sense of the >>             75035000
  << input parameter count, if necessary.                >>             75040000
                                                                        75045000
  transfer'log := if count < 0 then -(total'moved to'byte)              75050000
                               else total'moved;                        75055000
                                                                        75060000
  if odd'count then transfer'log := transfer'log + 1;                   75065000
                                                                        75070000
                                                                        75075000
  << All done!! >>                                                      75080000
                                                                        75085000
end;  << of procedure b08'silent'run >>                                 75090000
                                                                        75095000
$PAGE "PROCEDURE:  B08'CONTROL'MASK"                                    75100000
double procedure b08'control'mask(cb'info, dst'num, address,            75105000
                                count, flags              );            75110000
                                                                        75115000
  value                         cb'info, dst'num, address,              75120000
                                count, flags               ;            75125000
                                                                        75130000
  integer pointer               cb'info                    ;            75135000
                                                                        75140000
  integer                                dst'num, address,              75145000
                                count, flags               ;            75150000
                                                                        75155000
  option privileged, uncallable                            ;            75160000
                                                                        75165000
                                                                        75170000
COMMENT                                                                 75175000
                                                                        75180000
  PURPOSE:                                                              75185000
                                                                        75190000
    This procedure will send the CONTROL MASK command record            75195000
    to the 2608B.  The information in this record is passed             75200000
    in by the caller, and consists of a mask that will enable/          75205000
    disable the execution of selected ASCII control codes and           75210000
    device escape sequences.  For a description of the format           75215000
    of the control mask, refer to the CIPER document.                   75220000
                                                                        75225000
                                                                        75230000
  INPUT PARAMETERS:                                                     75235000
                                                                        75240000
    CB'INFO, which points to the control block information              75245000
      area of the logical driver.                                       75250000
                                                                        75255000
    DST'NUM, which is the data segment number of the DST where          75260000
      the control mask block will be moved from.  Note:                 75265000
      this must be a stack or extra data segment, the code does         75270000
      not support system buffers at this time.                          75275000
                                                                        75280000
    ADDRESS, which is the offset in dst'num where the control           75285000
      mask block begins.                                                75290000
                                                                        75295000
    COUNT, which is the size of the control mask block.                 75300000
      If count is positive, it specifies words.  If count is            75305000
      negative, it specifies bytes.                                     75310000
                                                                        75315000
    FLAGS, which are the request dependent flags passed by              75320000
      attachio to the logical driver.  The bit specifying sys-          75325000
      tem buffers is in flags, and is checked to make sure the          75330000
      caller is not using system buffers.                               75335000
                                                                        75340000
                                                                        75345000
  OUTPUT PARAMETERS:                                                    75350000
                                                                        75355000
    B08'CONTROL'MASK, a double word function return.  Word 0 is         75360000
      the completion status of the call.  Word 1 is the trans-          75365000
      fer log of information moved from the caller's area into          75370000
      the control mask command record.  The transfer log is re-         75375000
      turned in the same sense as the input parameter count.            75380000
                                                                        75385000
                                                                        75390000
  SIDE-EFFECTS:                                                         75395000
                                                                        75400000
    If the peripheral accepts the control mask command record,          75405000
    it will be placed in the control mask mode.  Refer to the           75410000
    CIPER document for details of this mode of operation.               75415000
                                                                        75420000
                                                                        75425000
  SPECIAL CONSIDERATIONS:                                               75430000
                                                                        75435000
    None.                                                               75440000
                                                                        75445000
                                                                        75450000
  CHANGE HISTORY:                                                       75455000
                                                                        75460000
    As issued.                                                          75465000
                                                                        75470000
;                                                                       75475000
$PAGE "PROCEDURE:  B08'CONTROL'MASK -- LOCAL VARIABLES"                 75480000
begin                                                                   75485000
                                                                        75490000
  << Function return variables: >>                                      75495000
                                                                        75500000
  double                                                                75505000
                                                                        75510000
    return'information            = b08'control'mask                    75515000
                                                                        75520000
  ;                                                                     75525000
                                                                        75530000
                                                                        75535000
  integer                                                               75540000
                                                                        75545000
    return'status                 = b08'control'mask                    75550000
      << Completion status of procedure call >>                         75555000
                                                                        75560000
   ,transfer'log                  = b08'control'mask + 1                75565000
      << Transfer count of data moved from caller to device >>          75570000
                                                                        75575000
  ;                                                                     75580000
                                                                        75585000
                                                                        75590000
  << Output record control pointers: >>                                 75595000
                                                                        75600000
  integer pointer                                                       75605000
                                                                        75610000
    o'r'control                                                         75615000
      << Points to control portion of record buffer area >>             75620000
                                                                        75625000
   ,o'r'data                                                            75630000
      << Points to base of data portion of record buffer >>             75635000
      << area.                                           >>             75640000
                                                                        75645000
  ;                                                                     75650000
                                                                        75655000
                                                                        75660000
  << Counters of how much to move, how much has been moved, >>          75665000
  << the total size of the control mask block, etc.  >>                 75670000
                                                                        75675000
  integer                                                               75680000
                                                                        75685000
    what'fits                                                           75690000
      << Size of the available data area of the output >>               75695000
      << record, in words                              >>               75700000
                                                                        75705000
   ,word'count                                                          75710000
      << Size of the control mask block, to the >>                      75715000
      << nearest word                                  >>               75720000
                                                                        75725000
   ,move'count                                                          75730000
      << Amount to be moved per record from the caller's >>             75735000
      << data area                                       >>             75740000
                                                                        75745000
   ,total'moved                                                         75750000
      << tally of how many words have been moved into >>                75755000
      << output record(s)                             >>                75760000
                                                                        75765000
  ;                                                                     75770000
                                                                        75775000
                                                                        75780000
  logical                                                               75785000
                                                                        75790000
    odd'count                                                           75795000
      << Keeps track of the fact that a negative count may >>           75800000
      << be an odd number of bytes, which causes some extra >>          75805000
      << manipulation on our part.                          >>          75810000
                                                                        75815000
  ;                                                                     75820000
  declare'move'from'data'segment;                                       75825000
                                                                        75830000
$PAGE "PROCEDURE:  B08'CONTROL'MASK -- PROCEDURE BODY"                  75835000
  << If the caller specified system buffers as the source >>            75840000
  << of the data, return with an illegal function error.  >>            75845000
                                                                        75850000
  if logical( flags.system'buffers ) then                               75855000
    begin                                                               75860000
      return'status := invalid'request;                                 75865000
      return;                                                           75870000
    end;                                                                75875000
                                                                        75880000
                                                                        75885000
  << Otherwise, get the dedicated output buffer. >>                     75890000
                                                                        75895000
  @o'r'control := cb'info(o'r'base)                                     75900000
                + cb'info(cds'area'base);                               75905000
                                                                        75910000
  @o'r'data := o'r'control(start) + @o'r'control;                       75915000
                                                                        75920000
                                                                        75925000
  << If there is any pending data in the record buffer, >>              75930000
  << it must be sent before the control mask is changed >>              75935000
  << so interpretation of previous data will be proper. >>              75940000
                                                                        75945000
  if logical( o'r'control(active) ) then                                75950000
    begin                                                               75955000
                                                                        75960000
      return'status := cpr'send'record(cb'info, o'r'control);           75965000
                                                                        75970000
      if return'status.general <> successful then                       75975000
        begin                                                           75980000
          return;                                                       75985000
        end;                                                            75990000
    end;                                                                75995000
                                                                        76000000
                                                                        76005000
  << Now convert the caller's count into a word count,    >>            76010000
  << rounding up an odd byte count to the next even word. >>            76015000
                                                                        76020000
  if count < 0 then                                                     76025000
    begin                                                               76030000
      word'count := (-count+1) to'word;                                 76035000
      odd'count := logical( count.bit'15 );                             76040000
    end                                                                 76045000
  else                                                                  76050000
    begin                                                               76055000
      word'count := count;                                              76060000
      odd'count := false;                                               76065000
    end;                                                                76070000
                                                                        76075000
                                                                        76080000
  << Build the initial record header and set the start of >>            76085000
  << block bit                                            >>            76090000
                                                                        76095000
  b08'build'header( o'r'control,                                        76100000
                    lgl'configuration,                                  76105000
                    control'mask );                                     76110000
                                                                        76115000
  o'r'data(sob'flag) := set'bit;                                        76120000
                                                                        76125000
                                                                        76130000
  << Calculate how many words will fit into what is left >>             76135000
  << of the record buffer                                >>             76140000
                                                                        76145000
  what'fits := (o'r'control(maximum'size)                               76150000
                - o'r'control(current'length)) to'word;                 76155000
                                                                        76160000
                                                                        76165000
  << Now loop, filling the record, sending it to the device, >>         76170000
  << until the word'count is exhausted.  On the last record, >>         76175000
  << the end of block bit should be set.                     >>         76180000
                                                                        76185000
  do                                                                    76190000
    begin                                                               76195000
                                                                        76200000
      << Determine how much of the request to move into  >>             76205000
      << the record.                                     >>             76210000
                                                                        76215000
      move'count := if word'count > what'fits                           76220000
          then what'fits                                                76225000
          else word'count;                                              76230000
                                                                        76235000
      << Reduce the requested count by the amount that will >>          76240000
      << be moved this pass.                                >>          76245000
                                                                        76250000
      word'count := word'count - move'count;                            76255000
                                                                        76260000
      << Move the data from the caller's area into the >>               76265000
      << record buffer area.                           >>               76270000
                                                                        76275000
      mfds(o'r'data( o'r'data(header'length) to'word),                  76280000
           dst'num,                                                     76285000
           address,                                                     76290000
        MOVE'COUNT);                                           <<07425>>76295000
                                                                        76300000
                                                                        76305000
      << Adjust the source address to reflect what has >>               76310000
      << been moved                                    >>               76315000
                                                                        76320000
   ADDRESS := ADDRESS + MOVE'COUNT;                            <<07425>>76325000
                                                                        76330000
                                                                        76335000
      << Adjust the record control information >>                       76340000
                                                                        76345000
      o'r'control(current'length) :=                                    76350000
          o'r'control(current'length) + (move'count to'byte);           76355000
                                                                        76360000
                                                                        76365000
      << If the word'count is exhausted, this will be the >>            76370000
      << last record, so set the end of block bit.        >>            76375000
                                                                        76380000
      if word'count = 0 then                                            76385000
        begin                                                           76390000
          o'r'data(eob'flag) := set'bit;                                76395000
                                                                        76400000
          if odd'count then                                             76405000
            begin                                                       76410000
              o'r'control(current'length) :=                            76415000
                  o'r'control(current'length) - 1;                      76420000
            end;                                                        76425000
        end;                                                            76430000
                                                                        76435000
                                                                        76440000
      << Send the record to the peripheral >>                           76445000
                                                                        76450000
      return'status := cpr'send'record(cb'info, o'r'control);           76455000
                                                                        76460000
      if return'status = successful then                                76465000
        begin                                                           76470000
          if word'count <> 0 then                                       76475000
            begin                                                       76480000
              b08'build'header( o'r'control,                            76485000
                                lgl'configuration,                      76490000
                                control'mask );                         76495000
            end;                                                        76500000
                                                                        76505000
          total'moved := total'moved + move'count;                      76510000
                                                                        76515000
        end                                                             76520000
      else                                                              76525000
        begin                                                           76530000
          << Force the word count to zero so we will exit >>            76535000
          << with an error condition.                     >>            76540000
                                                                        76545000
          word'count := 0;                                              76550000
                                                                        76555000
        end;                                                            76560000
                                                                        76565000
    end                                                                 76570000
  until word'count = 0;                                                 76575000
                                                                        76580000
                                                                        76585000
  << Adjust the transfer'log to reflect the sense of the >>             76590000
  << input parameter count, if necessary.                >>             76595000
                                                                        76600000
  transfer'log := if count < 0 then -(total'moved to'byte)              76605000
                               else total'moved;                        76610000
                                                                        76615000
  if odd'count then transfer'log := transfer'log + 1;                   76620000
                                                                        76625000
                                                                        76630000
  << All done!! >>                                                      76635000
                                                                        76640000
end;  << of procedure b08'control'mask >>                               76645000
                                                                        76650000
$PAGE "PROCEDURE:  B08'SET'EXT'MODE"                                    76655000
integer procedure B08'set'ext'mode(cb'info, mode'flag);                 76660000
                                                                        76665000
  value                            cb'info, mode'flag ;                 76670000
                                                                        76675000
  integer pointer                  cb'info            ;                 76680000
                                                                        76685000
  integer                                   mode'flag ;                 76690000
                                                                        76695000
  option privileged, uncallable;                                        76700000
                                                                        76705000
                                                                        76710000
COMMENT                                                                 76715000
                                                                        76720000
  PURPOSE:                                                              76725000
                                                                        76730000
    This procedure controls the caller's access to the ex-              76735000
    tended features of the 2608B.  At the start of each job,            76740000
    the caller defaults to non-extended feature mode for                76745000
    backward compatibility of existing subsystems and appli-            76750000
    cations.  If the caller wishes to directly access the               76755000
    features of the 2608B by escape sequence control, the               76760000
    appropriate function call (fdevicecontrol) must be made             76765000
    to enable the expanded features.                                    76770000
                                                                        76775000
                                                                        76780000
  INPUT PARAMETERS:                                                     76785000
                                                                        76790000
    CB'INFO, which points to the control block information              76795000
      area of the logical driver.  The extended'features flag           76800000
      is located in this area.                                          76805000
                                                                        76810000
    MODE'FLAG, which indicates which mode the caller desires:           76815000
      a value of zero places the caller in backward compati-            76820000
      bility mode, a value of one places the caller in exten-           76825000
      ded features mode.  All other values are reserved for             76830000
      future expansion.                                                 76835000
                                                                        76840000
                                                                        76845000
  OUTPUT PARAMETERS:                                                    76850000
                                                                        76855000
    B08'SET'EXT'MODE, which is the function return indicating           76860000
      the completion status.  A value of one is returned if             76865000
      the mode'flag was an acceptable value, otherwise a value          76870000
      of %4 (invalid request) is returned.                              76875000
                                                                        76880000
                                                                        76885000
  SIDE-EFFECTS:                                                         76890000
                                                                        76895000
    None.                                                               76900000
                                                                        76905000
                                                                        76910000
  SPECIAL CONSIDERATIONS:                                               76915000
                                                                        76920000
    DB must be set to the base of the CIPER data segment                76925000
    before calling this procedure.                                      76930000
                                                                        76935000
                                                                        76940000
  CHANGE HISTORY:                                                       76945000
                                                                        76950000
    As issued.                                                          76955000
                                                                        76960000
                                                                        76965000
;                                                                       76970000
$PAGE "PROCEDURE:  B08'SET'EXT'MODE -- PROCEUDURE BODY"                 76975000
begin                                                                   76980000
                                                                        76985000
  << Determine if the mode'flag parameter is within bounds >>           76990000
                                                                        76995000
  if 0 <= mode'flag <= 1 then                                           77000000
    begin                                                               77005000
                                                                        77010000
      cb'info(expanded'features) := (mode'flag <> 0);                   77015000
                                                                        77020000
      b08'set'ext'mode := successful;                                   77025000
                                                                        77030000
    end                                                                 77035000
  else                                                                  77040000
    begin                                                               77045000
                                                                        77050000
      b08'set'ext'mode := invalid'request;                              77055000
                                                                        77060000
    end;                                                                77065000
                                                                        77070000
end;  << of procedure b08'set'ext'mode >>                               77075000
                                                                        77080000
$PAGE "PROCEDURE B08'SET'STATUS'TYPES"                                  77085000
double procedure b08'set'status'types(cb'info, dst'num,                 77090000
                                      address, count, parm1 );          77095000
                                                                        77100000
  value                               cb'info, dst'num,                 77105000
                                      address, count, parm1  ;          77110000
                                                                        77115000
  integer pointer                     cb'info                ;          77120000
                                                                        77125000
  integer                                      dst'num,                 77130000
                                      address, count, parm1  ;          77135000
                                                                        77140000
  option privileged, uncallable;                                        77145000
                                                                        77150000
                                                                        77155000
COMMENT                                                                 77160000
                                                                        77165000
  PURPOSE:                                                              77170000
                                                                        77175000
    This procedure will set the status'enabled mask contained           77180000
    in cb'info to enable/disable reporting the reception of             77185000
    certain types of status.  In addition, configuration                77190000
    parameters associated with those status types will be ex-           77195000
    tracted from a sixteen word array passed by the caller.             77200000
    This configuration information will be assembled into a             77205000
    configuration record and sent to the peripheral.                    77210000
                                                                        77215000
                                                                        77220000
  INPUT PARAMETERS:                                                     77225000
                                                                        77230000
    CB'INFO, which points to the control block information              77235000
      area of the logical driver.  The status'enabled mask is           77240000
      one of the elements of cb'info.                                   77245000
                                                                        77250000
    DST'NUM, which is the data segment number of the segment            77255000
      where the caller specified array is located.                      77260000
                                                                        77265000
    ADDRESS, which is the offset within the data segment where          77270000
      the caller's array starts.                                        77275000
                                                                        77280000
    COUNT, which is the size of the caller's array.  If posi-           77285000
      tive, the count is in words, if negative, the count is            77290000
      in bytes.  If a count of less than 16 words is given,             77295000
      any missing parameters will revert to their default               77300000
      state.                                                            77305000
                                                                        77310000
    PARM1, which is the bit map indicating which status types           77315000
      should be enabled (1) or disabled (0).  Currenly, the             77320000
      status types defined are:                                         77325000
                                                                        77330000
            .( 0:14) - Reserved.  Set to zero.                          77335000
            .(14: 1) - Device Status                                    77340000
            .(15: 1) - Environmental Status                             77345000
                                                                        77350000
      Each word of the caller's array correspond to one of the          77355000
      bits of parm1.  Currently, the only word with signifi-            77360000
      cance is word 15, which sets the frequency of environ-            77365000
      mental status report generation.                                  77370000
                                                                        77375000
                                                                        77380000
  OUTPUT PARAMETERS:                                                    77385000
                                                                        77390000
    B08'SET'STATUS'TYPES, which is a double word function re-           77395000
      turn.  Word 0 is the completion status of the call.               77400000
      Word 1 is the transfer log of data moved from the                 77405000
      caller's array.                                                   77410000
                                                                        77415000
                                                                        77420000
  SIDE-EFFECTS:                                                         77425000
                                                                        77430000
    The information contained in the caller's array will be             77435000
    used to generate a configuration record for the peripheral.         77440000
    This record will affect the manner by which the peripheral          77445000
    communicates with the logical driver.                               77450000
                                                                        77455000
                                                                        77460000
  SPECIAL CONSIDERATIONS:                                               77465000
                                                                        77470000
    The caller's array must be at least sixteen words in length         77475000
    for this function to provide the desired results.                   77480000
                                                                        77485000
                                                                        77490000
  CHANGE HISTORY:                                                       77495000
                                                                        77500000
    As issued.                                                          77505000
                                                                        77510000
                                                                        77515000
;                                                                       77520000
                                                                        77525000
$PAGE "PROCEDURE:  B08'SET'STATUS'TYPES -- LOCAL VARIABLES"             77530000
begin                                                                   77535000
                                                                        77540000
  << Function return sub-parameters: >>                                 77545000
                                                                        77550000
  double                                                                77555000
                                                                        77560000
    return'information            = b08'set'status'types                77565000
                                                                        77570000
  ;                                                                     77575000
                                                                        77580000
                                                                        77585000
  integer                                                               77590000
                                                                        77595000
    return'status                 = b08'set'status'types                77600000
      << Completion status for the call >>                              77605000
                                                                        77610000
   ,transfer'log                  = b08'set'status'types + 1            77615000
      << Count of data moved from caller's array >>                     77620000
                                                                        77625000
  ;                                                                     77630000
                                                                        77635000
  declare'move'from'data'segment;                                       77640000
                                                                        77645000
$PAGE "PROCEDURE B08'SET'STATUS'TYPES -- PROCEDURE BODY"                77650000
                                                                        77655000
  << First, move parm1 into the status'enabled field >>                 77660000
                                                                        77665000
  cb'info(status'enabled) := parm1;                                     77670000
                                                                        77675000
                                                                        77680000
  << Now pull out the information for environmental status >>           77685000
                                                                        77690000
  if count <= -32 or count >= 16 then                                   77695000
    begin                                                               77700000
      mfds(cb'info(esb'frequency),dst'num,address+15,1);                77705000
      transfer'log := if count < 0 then -32 else 16;                    77710000
    end                                                                 77715000
  else                                                                  77720000
    begin                                                               77725000
      cb'info(esb'frequency) := 0;                                      77730000
      transfer'log := 0;                                                77735000
    end;                                                                77740000
                                                                        77745000
                                                                        77750000
  << Send the configuration record to the device >>                     77755000
                                                                        77760000
  return'status := b08'configure( cb'info,                              77765000
                                  true,  << sr'enable >>                77770000
                                  cb'info(esb'frequency)  );            77775000
                                                                        77780000
                                                                        77785000
end;  << of b08'set'status'types >>                                     77790000
                                                                        77795000
$PAGE "PROCEDURE:  B08'FLUSH'OUT'BUFFERS"                               77800000
integer procedure b08'flush'out'buffers( cb'info );                     77805000
                                                                        77810000
  value                                  cb'info  ;                     77815000
                                                                        77820000
  integer pointer                        cb'info  ;                     77825000
                                                                        77830000
  option privileged, uncallable                   ;                     77835000
                                                                        77840000
                                                                        77845000
COMMENT                                                                 77850000
                                                                        77855000
  PURPOSE:                                                              77860000
                                                                        77865000
    This procedure will cause any pending record buffers to             77870000
    be sent to the device.  This might be needed if the calling         77875000
    program wanted a small amount of data actually printed,             77880000
    but the amount of data was not great enough to completely           77885000
    fill a record and cause it to be sent.                              77890000
                                                                        77895000
    Currently, only the dedicated output buffer is sent, but            77900000
    later, a queuing mechanism for multiple buffers might be            77905000
    used.                                                               77910000
                                                                        77915000
                                                                        77920000
  INPUT PARAMETERS:                                                     77925000
                                                                        77930000
    CB'INFO, which points to the control block information              77935000
      area of the logical driver for this ldev.  Cb'info is             77940000
      an array of global information used by many of the pro-           77945000
      cedures that make up the logical driver.                          77950000
                                                                        77955000
                                                                        77960000
  OUTPUT PARAMETERS:                                                    77965000
                                                                        77970000
    B08'FLUSH'OUT'BUFFERS, which is a single word function              77975000
      return.  This returns the completion status of the call.          77980000
                                                                        77985000
                                                                        77990000
  SIDE-EFFECTS:                                                         77995000
                                                                        78000000
    If the pending records (if any) are successfully sent, only         78005000
    the record sequence numbers and receive ready count should          78010000
    change.  If any peripheral and/or transport service errors          78015000
    occur, then a device clear sequence could be generated.             78020000
                                                                        78025000
                                                                        78030000
  SPECIAL CONSIDERATIONS:                                               78035000
                                                                        78040000
    When called, DB should be set to the CIPER data segment.            78045000
                                                                        78050000
                                                                        78055000
  CHANGE HISTORY:                                                       78060000
                                                                        78065000
    As issued.                                                          78070000
                                                                        78075000
                                                                        78080000
;                                                                       78085000
$PAGE "PROCEDURE:  B08'FLUSH'OUT'BUFFERS -- LOCAL VARIABLES"            78090000
begin                                                                   78095000
                                                                        78100000
  integer pointer                                                       78105000
                                                                        78110000
    o'r'control                                                         78115000
      << points to control portion of output record buffer >>           78120000
      << area.                                             >>           78125000
                                                                        78130000
  ;                                                                     78135000
$PAGE "PROCEDURE:  B08'FLUSH'OUT'BUFFERS -- PROCEDURE BODY"             78140000
                                                                        78145000
  << Set up the pointer to the dedicated output buffer. >>              78150000
                                                                        78155000
  @o'r'control := cb'info(o'r'base)                                     78160000
                + cb'info(cds'area'base);                               78165000
                                                                        78170000
                                                                        78175000
  << If the record is in use, send it out >>                            78180000
                                                                        78185000
  if logical( o'r'control(active) ) then                                78190000
    begin                                                               78195000
                                                                        78200000
      b08'flush'out'buffer := cpr'send'record( cb'info,                 78205000
                                               o'r'control );           78210000
                                                                        78215000
    end                                                                 78220000
  else                                                                  78225000
    begin                                                               78230000
                                                                        78235000
      b08'flush'out'buffer := successful;                               78240000
                                                                        78245000
    end;                                                                78250000
                                                                        78255000
end;  << of procedure b08'flush'out'buffers >>                          78260000
                                                                        78265000
$PAGE "PROCEDURE:  B08'ERASE'BUFFERS"                                   78270000
integer procedure b08'erase'buffers( cb'info );                         78275000
                                                                        78280000
  value                              cb'info  ;                         78285000
                                                                        78290000
  integer pointer                    cb'info  ;                         78295000
                                                                        78300000
  option privileged, uncallable               ;                         78305000
                                                                        78310000
                                                                        78315000
COMMENT                                                                 78320000
                                                                        78325000
  PURPOSE:                                                              78330000
                                                                        78335000
    This procedure will mark the dedicated input and output             78340000
    record buffer areas as free.  This essentially deletes              78345000
    any information contained in them, as the next time they            78350000
    are used, the control information will be initialized and           78355000
    a new record started.                                               78360000
                                                                        78365000
                                                                        78370000
  INPUT PARAMETERS:                                                     78375000
                                                                        78380000
    CB'INFO, which points to the control block information              78385000
      area of the logical driver (level 7) for this ldev.               78390000
      Cb'info is an array of global information used by many            78395000
      of the procedures that implement the logical driver.              78400000
                                                                        78405000
                                                                        78410000
  OUTPUT PARAMETERS:                                                    78415000
                                                                        78420000
    B08'ERASE'BUFFERS, which is a single word function return.          78425000
      This word is the completion status (will always return a          78430000
      value of one for successful completion).                          78435000
                                                                        78440000
                                                                        78445000
  SIDE-EFFECTS:                                                         78450000
                                                                        78455000
    None.                                                               78460000
                                                                        78465000
                                                                        78470000
  SPECIAL CONSIDERATIONS:                                               78475000
                                                                        78480000
    When called, DB should be set to the base of the CIPER              78485000
    data segment.                                                       78490000
                                                                        78495000
                                                                        78500000
  CHANGE HISTORY:                                                       78505000
                                                                        78510000
    As issued.                                                          78515000
                                                                        78520000
                                                                        78525000
;                                                                       78530000
$PAGE "PROCEDURE:  B08'ERASE'BUFFERS -- LOCAL VARIABLES"                78535000
begin                                                                   78540000
                                                                        78545000
  logical pointer                                                       78550000
                                                                        78555000
    record'control                                                      78560000
      << Points to control portion of record buffer areas >>            78565000
                                                                        78570000
  ;                                                                     78575000
$PAGE "PROCEDURE:  B08'ERASE'BUFFERS -- PROCEDURE BODY"                 78580000
                                                                        78585000
  << Free up the dedicated output buffer. >>                            78590000
                                                                        78595000
  @record'control := cb'info(o'r'base)                                  78600000
                   + cb'info(cds'area'base);                            78605000
                                                                        78610000
  record'control(active) := free;                                       78615000
                                                                        78620000
  record'control(current'length) := 0;                                  78625000
                                                                        78630000
  record'control(current'position) :=                                   78635000
      (record'control(start) to'byte);                                  78640000
                                                                        78645000
                                                                        78650000
  << Free up the dedicated input buffer. >>                             78655000
                                                                        78660000
  @record'control := cb'info(i'r'base)                                  78665000
                   + cb'info(cds'area'base);                            78670000
                                                                        78675000
  record'control(active) := free;                                       78680000
                                                                        78685000
  record'control(current'length) := 0;                                  78690000
                                                                        78695000
  record'control(current'position) :=                                   78700000
      (record'control(start) to'byte);                                  78705000
                                                                        78710000
                                                                        78715000
  << All done >>                                                        78720000
                                                                        78725000
  b08'erase'buffers := successful;                                      78730000
                                                                        78735000
end;  << of procedure b08'erase'buffers >>                              78740000
                                                                        78745000
$IF X9 = ON  << ON = INCLUDE DEBUGGING CODE >>                 <<04434>>78750000
$PAGE "PROCEDURE:  B08'SET'REC'LENGTH"                                  78755000
double procedure b08'set'rec'length(cb'info, record'length);            78760000
                                                                        78765000
  value                             cb'info, record'length ;            78770000
                                                                        78775000
  integer pointer                   cb'info                ;            78780000
                                                                        78785000
  integer                                    record'length ;            78790000
                                                                        78795000
  option privileged, uncallable                            ;            78800000
                                                                        78805000
                                                                        78810000
COMMENT                                                                 78815000
                                                                        78820000
  PURPOSE:                                                              78825000
                                                                        78830000
    This procedure will adjust the maximum record size for all          78835000
    records sent and received.  This is useful for performance          78840000
    measurements where record size is one of the variables.             78845000
                                                                        78850000
                                                                        78855000
  INPUT PARAMETERS:                                                     78860000
                                                                        78865000
    CB'INFO, which points to the level 7 control block informa-         78870000
      tion area of the particular LDEV.  Pointers to all of the         78875000
      record buffer areas are maintained here.                          78880000
                                                                        78885000
    RECORD'LENGTH, which indicates the maximum size, in bytes,          78890000
      that a record may be.  This value is plugged into the             78895000
      maximum'size field of each record buffer control area.            78900000
                                                                        78905000
                                                                        78910000
  OUTPUT PARAMETERS:                                                    78915000
                                                                        78920000
    B08'SET'REC'LENGTH, which is a double word function return.         78925000
      Word 0 is the completion status for the call.  Word 1 is          78930000
      the previous configured record size, in bytes.                    78935000
                                                                        78940000
                                                                        78945000
  SIDE-EFFECTS:                                                         78950000
                                                                        78955000
    None.                                                               78960000
                                                                        78965000
                                                                        78970000
  SPECIAL CONSIDERATIONS:                                               78975000
                                                                        78980000
    When called, DB must be set to the CIPER data segment.              78985000
                                                                        78990000
                                                                        78995000
  CHANGE HISTORY:                                                       79000000
                                                                        79005000
    As issued.                                                          79010000
                                                                        79015000
                                                                        79020000
;                                                                       79025000
$PAGE "PROCEDURE:  B08'SET'REC'LENGTH -- LOCAL VARIABLES"               79030000
begin                                                                   79035000
                                                                        79040000
  << Return status definitions: >>                                      79045000
                                                                        79050000
  double                                                                79055000
                                                                        79060000
    return'information            = b08'set'rec'length                  79065000
                                                                        79070000
  ;                                                                     79075000
                                                                        79080000
                                                                        79085000
  integer                                                               79090000
                                                                        79095000
    return'status                 = b08'set'rec'length                  79100000
                                                                        79105000
   ,transfer'log                  = b08'set'rec'length + 1              79110000
                                                                        79115000
  ;                                                                     79120000
                                                                        79125000
                                                                        79130000
  << Pointer to the record buffer control area: >>                      79135000
                                                                        79140000
  integer pointer                                                       79145000
                                                                        79150000
    i'o'control                                                         79155000
                                                                        79160000
  ;                                                                     79165000
$PAGE "PROCEDURE:  B08'SET'REC'LENGTH -- PROCEDURE BODY"                79170000
  << Modify the dedicated output buffer first, and let its >>           79175000
  << current size be returned as the transfer log.         >>           79180000
                                                                        79185000
  @i'o'control := cb'info(o'r'base)                                     79190000
                + cb'info(cds'area'base);                               79195000
                                                                        79200000
  transfer'log := i'o'control(maximum'size);                            79205000
                                                                        79210000
  i'o'control(maximum'size) := record'length;                           79215000
                                                                        79220000
                                                                        79225000
  << Fix up the dedicated input buffer next >>                          79230000
                                                                        79235000
  @i'o'control := cb'info(i'r'base)                                     79240000
                + cb'info(cds'area'base);                               79245000
                                                                        79250000
  i'o'control(maximum'size) := record'length;                           79255000
                                                                        79260000
                                                                        79265000
  << Fix up all of the record buffers in the free list >>               79270000
                                                                        79275000
  @i'o'control := cb'info(free'buff'list);                              79280000
                                                                        79285000
  while @i'o'control is'not'nil do                                      79290000
    begin                                                               79295000
                                                                        79300000
      @i'o'control := @i'o'control                                      79305000
                    + cb'info(cds'area'base);                           79310000
                                                                        79315000
      i'o'control(maximum'size) := record'length;                       79320000
                                                                        79325000
      @i'o'control := i'o'control(forward'link);                        79330000
                                                                        79335000
    end;                                                                79340000
                                                                        79345000
                                                                        79350000
  << All done !! >>                                                     79355000
                                                                        79360000
  return'status := successful;                                          79365000
                                                                        79370000
end;  << of procedure b08'set'rec'length >>                             79375000
                                                                        79380000
$PAGE "PROCEDURE:  CPR'TEST'SHUTDOWN"                                   79385000
double procedure cpr'test'shutdown( level, limit );                     79390000
                                                                        79395000
  value                             level, limit  ;                     79400000
                                                                        79405000
  integer                           level, limit  ;                     79410000
                                                                        79415000
  option privileged, uncallable                   ;                     79420000
                                                                        79425000
                                                                        79430000
COMMENT                                                                 79435000
                                                                        79440000
  PURPOSE:                                                              79445000
                                                                        79450000
    This procedure will provide an automated test of the shut-          79455000
    down mechanism.  It does this by recursing several times,           79460000
    each time adding an increasing amount of crap on the stack.         79465000
    When the limit is reached, it calls cpr'internal'error to           79470000
    initiate the shutdown.                                              79475000
                                                                        79480000
    In the future, it would be nice if this would test two              79485000
    other possibilities:  that of corrupted ldev parameters             79490000
    and a generally corrupted stack.                                    79495000
                                                                        79500000
                                                                        79505000
  INPUT PARAMETERS:                                                     79510000
                                                                        79515000
    LEVEL, which is used to indicate how many times we have             79520000
      recursed.                                                         79525000
                                                                        79530000
    LIMIT, which is the maximum number of times to recurse              79535000
      before calling cpr'internal'error.                                79540000
                                                                        79545000
                                                                        79550000
  OUTPUT PARAMETERS:                                                    79555000
                                                                        79560000
    None.                                                               79565000
                                                                        79570000
                                                                        79575000
  SIDE-EFFECTS:                                                         79580000
                                                                        79585000
    The LDEV that is shut down will be unavailable until either         79590000
    the ldtx entry is manually fixed up or the system is warm-          79595000
    started.                                                            79600000
                                                                        79605000
                                                                        79610000
  SPECIAL CONSIDERATIONS:                                               79615000
                                                                        79620000
    None.                                                               79625000
                                                                        79630000
                                                                        79635000
  CHANGE HISTORY:                                                       79640000
                                                                        79645000
    None.                                                               79650000
                                                                        79655000
                                                                        79660000
;                                                                       79665000
$PAGE "PROCEDURE:  CPR'TEST'SHUTDOWN -- PROCEDURE BODY"                 79670000
begin                                                                   79675000
                                                                        79680000
  x := level;                                                           79685000
  while dxbz do assemble( adds 1 );                                     79690000
                                                                        79695000
  if level < limit then cpr'test'shutdown( level + 1, limit )           79700000
                   else cpr'internal'error;                             79705000
                                                                        79710000
end;  << of procedure cpr'test'shutdown >>                              79715000
                                                                        79720000
$IF                                                            <<04434>>79725000
$PAGE "PROCEDURE:  B08'INITIALIZE"                                      79730000
double procedure b08'initialize(control'table, control'block,           79735000
                                cb'info, ldev                );         79740000
                                                                        79745000
  value                         control'table, control'block,           79750000
                                cb'info, ldev                 ;         79755000
                                                                        79760000
  logical pointer               control'table, control'block            79765000
                                                              ;         79770000
                                                                        79775000
  integer pointer                                                       79780000
                                cb'info                       ;         79785000
                                                                        79790000
  integer                                ldev                           79795000
                                                              ;         79800000
                                                                        79805000
  option privileged, uncallable                               ;         79810000
                                                                        79815000
                                                                        79820000
COMMENT                                                                 79825000
                                                                        79830000
  PURPOSE:                                                              79835000
                                                                        79840000
    This procedure will perform all initialization of the               79845000
    Level 7 control block information area and the informa-             79850000
    tion area extension.                                                79855000
                                                                        79860000
    During this process, the transport service will be initial-         79865000
    ized, and a device clear command will be sent to the per-           79870000
    ipheral.                                                            79875000
                                                                        79880000
    This procedure should only be called once per CIPER device,         79885000
    typically upon the first fopen to that device after the             79890000
    system has been brought up.                                         79895000
                                                                        79900000
                                                                        79905000
  INPUT PARAMETERS:                                                     79910000
                                                                        79915000
    CONTROL'TABLE, which points to the control table for this           79920000
      logical device.                                                   79925000
                                                                        79930000
    CONTROL'BLOCK, which points to the control block for Level          79935000
      7 for this logical device.                                        79940000
                                                                        79945000
    CB'INFO, which is a pointer to the control block informa-           79950000
      tion area of the logical driver (level 7) for this ldev.          79955000
                                                                        79960000
    LDEV, which is the logical device number of the device the          79965000
      caller is requesting.                                             79970000
                                                                        79975000
                                                                        79980000
  OUTPUT PARAMETERS:                                                    79985000
                                                                        79990000
    B08'INITIALIZE, a double word which contains the following          79995000
      information:                                                      80000000
                                                                        80005000
        word 0 - completion status of the initialization call.          80010000
                 A value of one indicates successful comple-            80015000
                 tion.  Other values indicate certain error             80020000
                 conditions have occurred while initializing.           80025000
                                                                        80030000
        word 1 - reserved.                                              80035000
                                                                        80040000
                                                                        80045000
  SIDE-EFFECTS:                                                         80050000
                                                                        80055000
    If this procedure reaches a successful completion, all              80060000
    areas of the CIPER data segment will be initialized.  In            80065000
    addition, the logical driver will be synchronized with the          80070000
    device due to the device clear command sent.                        80075000
                                                                        80080000
                                                                        80085000
  SPECIAL CONSIDERATIONS:                                               80090000
                                                                        80095000
    None.                                                               80100000
                                                                        80105000
                                                                        80110000
  CHANGE HISTORY:                                                       80115000
                                                                        80120000
    As issued.                                                          80125000
                                                                        80130000
;                                                                       80135000
$PAGE "PROCEDURE:  B08'INITIALIZE -- LOCAL VARIABLES"                   80140000
begin                                                                   80145000
                                                                        80150000
  << Sub-parameter definitions of double word return >>                 80155000
                                                                        80160000
  double                                                                80165000
                                                                        80170000
    return'information            = b08'initialize                      80175000
      << contains two words of completion status, as de- >>             80180000
      << fined below:                                    >>             80185000
                                                                        80190000
  ;                                                                     80195000
                                                                        80200000
                                                                        80205000
  integer                                                               80210000
                                                                        80215000
    return'status                 = b08'initialize                      80220000
      << completion status of the initialization call >>                80225000
                                                                        80230000
    ,LPDT'INDEX << FOR LPDT ACCESS >>                          <<07425>>80235000
                                                               <<07425>>80240000
                                                               <<07425>>80245000
   ,transfer'log                  = b08'initialize + 1                  80250000
      << number of words/bytes transferred (reserved and >>             80255000
      << set to zero for now)                            >>             80260000
                                                               <<07425>>80265000
   ,usable'packet'space                                        <<07425>>80270000
      << amount of space in level 4 packets available for   >> <<07425>>80275000
      << level 7 record data (rest is level 4 overhead).    >> <<07425>>80280000
                                                               <<07425>>80285000
   ,remainder                                                  <<07425>>80290000
      << amount of record that could be left over after an  >> <<07425>>80295000
      << integral number of packets have been used.         >> <<07425>>80300000
                                                                        80305000
  ;                                                                     80310000
                                                                        80315000
                                                                        80320000
  integer pointer                                                       80325000
                                                                        80330000
    release'ptr                                                         80335000
      << points to temporary area of CDS that will be re- >>            80340000
      << leased when initialization if finished.          >>            80345000
                                                                        80350000
                                                               <<07425>>80355000
                                                               <<07425>>80360000
                                                               <<07425>>80365000
                                                               <<07425>>80370000
                                                               <<07425>>80375000
                                                                        80380000
  ;                                                                     80385000
                                                                        80390000
                                                                        80395000
  << Constants used during initializaton >>                             80400000
                                                                        80405000
  equate                                                                80410000
                                                                        80415000
    init'record'size              = 256                                 80420000
      << size of temporary record buffer areas >>                       80425000
                                                                        80430000
   ,init'ESB'size                 = 32                                  80435000
      << size of initial environmental status block area >>             80440000
                                                                        80445000
   ,init'packet'space             = 20                                  80450000
      << size of temporary packet headers and trailers >>               80455000
                                                                        80460000
   ,fixed'overhead'size           = device'status'size                  80465000
                                  + job'report'size                     80470000
                                  + xlator'buff'size + 1                80475000
                                  + product'id'size                     80480000
                                  + log'buffer'size                     80485000
                                  + comp'status'size                    80490000
                                                                        80495000
      << amount of space in CDS that we will always need, >>            80500000
      << regardless of size of device buffers and environ- >>           80505000
      << mental status size.                               >>           80510000
                                                                        80515000
   ,debug'suptype'def             = [8/10,8/0]                          80520000
      << cds area suptype for debugging scratch areas >>                80525000
                                                                        80530000
  ;                                                                     80535000
                                                                        80540000
                                                                        80545000
$PAGE "PROCEDURE:  B08'INITIALIZE -- SUBROUTINE: INIT'CB'INFO"          80550000
subroutine init'cb'info;                                                80555000
                                                                        80560000
COMMENT                                                                 80565000
                                                                        80570000
  PURPOSE:                                                              80575000
    This subroutine will initialize certain variables contained         80580000
    in the control block information area of Level 7.  It is            80585000
    called once, durdata segment initialization.                        80590000
                                                                        80595000
  INPUT PARAMETERS:                                                     80600000
    None.                                                               80605000
                                                                        80610000
  OUTPUT PARAMETERS:                                                    80615000
    None.                                                               80620000
                                                                        80625000
  SIDE-EFFECTS:                                                         80630000
    Initializes parts of the control block information area             80635000
    for the logical driver.                                             80640000
                                                                        80645000
  SPECIAL CONSIDERATIONS:                                               80650000
    This procedure should only be called once, after the                80655000
    control block information area is allocated by calling              80660000
    cpr'init'cbi.  This procedure expects the variable cb'info          80665000
    to be pointing to the information area.                             80670000
                                                                        80675000
                                                                        80680000
  CHANGE HISTORY:                                                       80685000
                                                                        80690000
    As issued.                                                          80695000
                                                                        80700000
                                                                        80705000
;                                                                       80710000
begin                                                                   80715000
                                                                        80720000
  << First, initialize the logical device number >>                     80725000
                                                                        80730000
  cb'info(logical'device) := ldev;                                      80735000
                                                                        80740000
                                                                        80745000
  << Next, initialize the CIPER data segment value >>                   80750000
                                                                        80755000
  cb'info(ciper'dst) := control'table(ct'cds'dst'num);                  80760000
                                                                        80765000
                                                                        80770000
  << Initialize the device record size >>                               80775000
                                                                        80780000
  cb'info(device'buffer'size) := init'record'size;                      80785000
                                                                        80790000
                                                                        80795000
  << Initialize the environmental status tank size >>                   80800000
                                                                        80805000
  cb'info(device'env'status'size) := init'ESB'size;                     80810000
                                                                        80815000
                                                                        80820000
  << Initialize the control table pointer >>                            80825000
                                                                        80830000
  cb'info(ct'ptr) := @control'table;                                    80835000
                                                                        80840000
                                                                        80845000
  << Set ESB frequency to zero, so no ESB's will be spontan- >>         80850000
  << eously reported before anyone wants them.               >>         80855000
                                                                        80860000
  cb'info(esb'frequency) := 0;                                          80865000
                                                                        80870000
                                                                        80875000
  << Disable all logging events, unless certain events >>               80880000
  << get explicitly enabled.                           >>               80885000
                                                                        80890000
  cb'info(event'map) := %100000;                                        80895000
  cb'info(logging'dst) := nul'dseg;                                     80900000
                                                                        80905000
                                                                        80910000
  << Initialize the default access mode flag >>                         80915000
                                                                        80920000
  LPDT'INDEX := LOGICAL(LDEV) * LPDT'ENTRY'SIZE;               <<07425>>80925000
  cb'info(default'access'mode) :=                                       80930000
   (LPDT'SUBTYPE                                               <<07425>>80935000
      = feature'access'subtype);                                        80940000
                                                                        80945000
                                                                        80950000
  << Initialize the driver transaction sequence to zero >>     <<07425>>80955000
                                                               <<07425>>80960000
  cb'info(dvr'seq) := 0;                                       <<07425>>80965000
                                                               <<07425>>80970000
                                                               <<07425>>80975000
  << All done! >>                                                       80980000
                                                                        80985000
end;  << init'cb'info >>                                                80990000
                                                                        80995000
$PAGE "PROCEDURE:  B08'INITIALIZE -- SUBROUTINE:  B08'RECORD'INIT"      81000000
logical subroutine b08'record'init(record'base);                        81005000
                                                                        81010000
  value                            record'base ;                        81015000
  integer pointer                  record'base ;                        81020000
                                                                        81025000
COMMENT                                                                 81030000
                                                                        81035000
  PURPOSE:                                                              81040000
                                                                        81045000
    This subroutine will initialize the record buffer control           81050000
    information for the record buffer area passed.  The control         81055000
    information includes the area length, record starting               81060000
    position, current position, current length, and the clean/          81065000
    dirty flag.                                                         81070000
                                                                        81075000
                                                                        81080000
  INPUT PARAMETERS:                                                     81085000
                                                                        81090000
    RECORD'BASE, which upon entry is the address of the base of         81095000
    the appropriate record buffer area (word address).                  81100000
                                                                        81105000
                                                                        81110000
  OUTPUT PARAMETERS:                                                    81115000
                                                                        81120000
    None.                                                               81125000
                                                                        81130000
                                                                        81135000
  SIDE-EFFECTS:                                                         81140000
                                                                        81145000
    None.                                                               81150000
                                                                        81155000
                                                                        81160000
  SPECIAL CONSIDERATIONS:                                               81165000
                                                                        81170000
    None.                                                               81175000
                                                                        81180000
                                                                        81185000
  CHANGE HISTORY:                                                       81190000
                                                                        81195000
    As issued.                                                          81200000
                                                                        81205000
                                                                        81210000
;                                                                       81215000
begin  << subroutine b08'record'init >>                                 81220000
                                                                        81225000
  << Plug in the overall length of the buffer area >>                   81230000
                                                                        81235000
  record'base(length) := record'overhead                                81240000
      + cb'info(packet'header'size)                                     81245000
      + cb'info(device'buffer'size) to'word                             81250000
      + cb'info(packet'trailer'size)                                    81255000
      + 1; << extra word at end may be needed during mfds >>            81260000
           << in b08'write'data                           >>            81265000
                                                                        81270000
                                                                        81275000
  << Set the record starting position past the control in- >>           81280000
  << formation and packet header space.  The amount is re- >>           81285000
  << duced by one because the record buffer is offset by   >>           81290000
  << one word (the length word at buffer(-1) )             >>           81295000
                                                                        81300000
  record'base(start) := record'overhead                                 81305000
                      + cb'info(packet'header'size) - 1;                81310000
                                                                        81315000
  << Set the current position (a byte pointer value) to      >>         81320000
  << the same position as the start.                         >>         81325000
                                                                        81330000
  record'base(current'position) := record'base(start) to'byte;          81335000
                                                                        81340000
  << Set the current length to zero >>                                  81345000
                                                                        81350000
  record'base(current'length) := 0;                                     81355000
                                                                        81360000
  << Set the maximum size equal to the reported device buf- >>          81365000
  << fer size.                                              >>          81370000
                                                                        81375000
  record'base(maximum'size) := cb'info(device'buffer'size);             81380000
                                                                        81385000
  << Link into the free-list >>                                         81390000
                                                                        81395000
  b08'release'buffer(cb'info, record'base);                             81400000
                                                                        81405000
  << Set return value equal to pointer past this new buffer >>          81410000
                                                                        81415000
  b08'record'init := @record'base + record'base(length);                81420000
                                                                        81425000
  << All done !! >>                                                     81430000
                                                                        81435000
end;  << subroutine b08'record'init >>                                  81440000
                                                                        81445000
$PAGE "PROCEDURE:  B08'INITIALIZE -- SUBROUTINE:  INIT'CDS'AREA"        81450000
subroutine init'cds'area(init'ptr, number'of'buffers);                  81455000
                                                                        81460000
  value                  init'ptr, number'of'buffers ;                  81465000
                                                                        81470000
  integer pointer        init'ptr                    ;                  81475000
                                                                        81480000
  integer                          number'of'buffers ;                  81485000
                                                                        81490000
COMMENT                                                                 81495000
                                                                        81500000
  PURPOSE:                                                              81505000
                                                                        81510000
    This subroutine will initialize a new cds area.  It will            81515000
    build all record buffer areas, status tank areas, etc.,             81520000
    and will update pointers contained in cb'info to reflect            81525000
    the new location of those areas.                                    81530000
                                                                        81535000
                                                                        81540000
  INPUT PARAMETERS:                                                     81545000
                                                                        81550000
    INIT'PTR, which upon entry is the address of the memory             81555000
      cell that contains the address of the area to initial-            81560000
      ize.                                                              81565000
                                                                        81570000
    NUMBER'OF'BUFFERS, which indicates how many record buffer           81575000
      areas to initialize in the cds area.  All of these are            81580000
      linked into the free-list, and then one is removed for            81585000
      the dedicated output buffer, and a second buffer is               81590000
      removed for the dedicated input buffer.                           81595000
                                                                        81600000
                                                                        81605000
  OUTPUT PARAMETERS:                                                    81610000
                                                                        81615000
    None.                                                               81620000
                                                                        81625000
                                                                        81630000
  SIDE-EFFECTS:                                                         81635000
                                                                        81640000
    Alters certain portions of the control block information            81645000
    area, primarily pointers to buffers and status tanks.               81650000
                                                                        81655000
                                                                        81660000
  SPECIAL CONSIDERATIONS:                                               81665000
                                                                        81670000
    This routine double checks that it has not allocated any            81675000
    memory outside of the requested cds area.  If it has, a             81680000
    call to cpr'internal'error is made.                                 81685000
                                                                        81690000
                                                                        81695000
  CHANGE HISTORY:                                                       81700000
                                                                        81705000
    As issued.                                                          81710000
                                                                        81715000
                                                                        81720000
;                                                                       81725000
$PAGE                                                                   81730000
begin  << subroutine init'cds'area >>                                   81735000
  << Calculate the storage requirements of this device >>               81740000
                                                                        81745000
  cb'info(storage'requirements) :=                                      81750000
      fixed'overhead'size                                               81755000
    + ((( cb'info(device'env'status'size)+1 ) to'word ) + 1)            81760000
    + ( number'of'buffers *                                             81765000
      ( cb'info(packet'header'size)                                     81770000
      + (cb'info(device'buffer'size) to'word)                           81775000
      + cb'info(packet'trailer'size)                                    81780000
      + record'overhead + 1 ) );                                        81785000
                                                                        81790000
  << Now get a new area of the size needed >>                           81795000
                                                                        81800000
  if cb'info(temp'area) = nil then                                      81805000
    begin                                                               81810000
      cb'info(cds'area'base) :=                                         81815000
        cpr'get'2ndary'cds'area( cb'info(storage'requirements),         81820000
                                 cbix'suptype'def lor 7,                81825000
                                 0                           );         81830000
    end                                                                 81835000
  else                                                                  81840000
    begin                                                               81845000
      cb'info(cds'area'base) :=                                         81850000
        cpr'get'cds'area( cb'info(storage'requirements),                81855000
                          cbix'suptype'def lor 7,                       81860000
                          0                              );             81865000
    end;                                                                81870000
                                                                        81875000
                                                                        81880000
  << Initialize the area pointer.  The +1 allows an offset >>           81885000
  << for the length word which is in front of each major   >>           81890000
  << area of the CBIX.                                     >>           81895000
                                                                        81900000
  @init'ptr := init'ptr + 1;                                            81905000
                                                                        81910000
  << Set up the record buffer areas >>                                  81915000
                                                                        81920000
  do                                                                    81925000
    begin                                                               81930000
      @init'ptr := b08'record'init(init'ptr);                           81935000
      number'of'buffers := number'of'buffers - 1;                       81940000
    end                                                                 81945000
  until number'of'buffers = 0;                                          81950000
                                                                        81955000
  cb'info(o'r'base) := integer( b08'get'buffer(cb'info,                 81960000
                                               no'overwrite) )          81965000
                     - cb'info(cds'area'base);                          81970000
  cb'info(i'r'base) := integer( b08'get'buffer(cb'info,                 81975000
                                               no'overwrite) )          81980000
                     - cb'info(cds'area'base);                          81985000
                                                                        81990000
                                                                        81995000
  << Set up the device status area, and move any >>                     82000000
  << old status information into the new area.   >>                     82005000
                                                                        82010000
  init'ptr(length) := device'status'size;                               82015000
                                                                        82020000
                                                                        82025000
  if cb'info(temp'area) <> 0 then                                       82030000
    begin                                                               82035000
      @release'ptr := cb'info(dev'status'base)                          82040000
                    + cb'info(temp'area);                               82045000
      move init'ptr := release'ptr,                                     82050000
         ((device'status'length+1) to'word);                            82055000
    end                                                        <<04422>>82060000
  else                                                         <<04422>>82065000
    begin                                                      <<04422>>82070000
      << Initialize the device status area so that it looks >> <<04422>>82075000
      << like the device is on-line.  That way, when the    >> <<04422>>82080000
      << first device status report is received, if the de- >> <<04422>>82085000
      << vice is off-line an operator message will get sent >> <<04422>>82090000
                                                               <<04422>>82095000
      init'ptr(on'line) := set'bit;                            <<04422>>82100000
    end;                                                       <<04422>>82105000
                                                                        82110000
  cb'info(dev'status'base) := @init'ptr                                 82115000
                            - cb'info(cds'area'base);                   82120000
  @init'ptr := @init'ptr + init'ptr(length);                            82125000
                                                                        82130000
                                                                        82135000
  << Set up the composite status area >>                                82140000
                                                                        82145000
  init'ptr(length) := comp'status'size;                                 82150000
  cb'info(composite'status'area) := @init'ptr                           82155000
                                  - cb'info(cds'area'base);             82160000
  @init'ptr := @init'ptr + init'ptr(length);                            82165000
                                                                        82170000
                                                                        82175000
  << Set up the new environmental status area. >>                       82180000
                                                                        82185000
  init'ptr(length) := 1                                                 82190000
      + ((cb'info(device'env'status'size)+1) to'word);                  82195000
                                                                        82200000
  cb'info(env'status'base) := @init'ptr                                 82205000
                            - cb'info(cds'area'base);                   82210000
  @init'ptr := @init'ptr + init'ptr(length);                            82215000
                                                                        82220000
                                                                        82225000
  << Set up the job report area >>                                      82230000
                                                                        82235000
  init'ptr(length) := job'report'size;                                  82240000
  cb'info(job'report'base) := @init'ptr                                 82245000
                            - cb'info(cds'area'base);                   82250000
  @init'ptr := @init'ptr + init'ptr(length);                            82255000
                                                                        82260000
                                                                        82265000
  << Set up the buffers for escape sequence con- >>                     82270000
  << struction by cpr'xlator.                    >>                     82275000
                                                                        82280000
  init'ptr(length) := xlator'buff'size + 1;                             82285000
  cb'info(sequence'1'buffer) := ( @init'ptr                             82290000
      - cb'info(cds'area'base) ) to'byte;                               82295000
  @init'ptr := @init'ptr + init'ptr(length);                            82300000
                                                                        82305000
                                                                        82310000
  << Finally, set up the array for the product  >>                      82315000
  << identification string.                     >>                      82320000
                                                                        82325000
  init'ptr(length) := product'id'size;                                  82330000
                                                                        82335000
  if cb'info(temp'area) <> 0 then                                       82340000
    begin                                                               82345000
      @release'ptr := cb'info(product'number) +                         82350000
                      cb'info(temp'area);                               82355000
      move init'ptr := release'ptr,(product'id'size - 1);               82360000
    end;                                                                82365000
                                                                        82370000
  cb'info(product'number) := @init'ptr                                  82375000
                           - cb'info(cds'area'base);                    82380000
  @init'ptr := @init'ptr + init'ptr(length);                            82385000
                                                                        82390000
                                                                        82395000
                                                                        82400000
  << Initialize the area used by the logging subsystem >>               82405000
                                                                        82410000
  init'ptr(length) := log'buffer'size;                                  82415000
  init'ptr := head'entry'length;                                        82420000
                                                                        82425000
  cb'info(logging'buffer) := @init'ptr                                  82430000
                           - cb'info(cds'area'base);                    82435000
                                                                        82440000
                                                                        82445000
end;  << of subroutine init'cds'area >>                                 82450000
                                                                        82455000
$PAGE "PROCEDURE:  B08'INITIALIZE -- PROCEDURE BODY"                    82460000
  init'cb'info;                                                         82465000
                                                                        82470000
  << Now tell the transport service to initialize. >>                   82475000
  << It will allocate the level dependent informa- >>                   82480000
  << tion areas it needs, and will return the size >>                   82485000
  << of headers and/or trailers it needs.          >>                   82490000
                                                                        82495000
  return'information :=                                                 82500000
    b08'network'protocol( control'table,                                82505000
                          transport'initialize,                         82510000
                          @cb'info(packet'header'size),                 82515000
                          0,                                            82520000
                          control'table(ct'cds'dst'num),                82525000
                          ldev                                          82530000
                        );                                              82535000
                                                                        82540000
  << check the return'status >>                                         82545000
  if return'status <> no'errors then return;                            82550000
                                                                        82555000
                                                                        82560000
  << Send a transport open command, to allocate the >>                  82565000
  << transport service where required.              >>                  82570000
                                                                        82575000
  return'information :=                                                 82580000
    b08'network'protocol( control'table,                                82585000
                          transport'open,                               82590000
                          0,                                            82595000
                          0,                                            82600000
                          control'table(ct'cds'dst'num),                82605000
                          ldev                                          82610000
                        );                                              82615000
                                                                        82620000
                                                                        82625000
  << Check the return'status >>                                         82630000
                                                                        82635000
  if return'status <> no'errors then return;                            82640000
                                                                        82645000
                                                                        82650000
                                                                        82655000
                                                                        82660000
  << Do minimal initialization of temporary cds area >>                 82665000
  << so we can communicate with the device.          >>                 82670000
                                                                        82675000
  init'cds'area( cb'info(cds'area'base)                                 82680000
                ,2  << # of record buffer areas >>  );                  82685000
                                                                        82690000
                                                                        82695000
  << Done with short initialization. >>                                 82700000
  << Now go through a device clear sequence, so we >>                   82705000
  << can begin communication with the peripheral.  >>                   82710000
                                                                        82715000
  return'status := b08'device'clear(cb'info,%37);                       82720000
                                                                        82725000
  << check the return'status >>                                         82730000
  if return'status <> no'errors and                                     82735000
     return'status <> record'sequence'error and                <<07425>>82740000
     return'status <> pf'error then                                     82745000
    begin                                                               82750000
      << Could not complete the device clear seq- >>                    82755000
      << quence, so return with error.            >>                    82760000
                                                                        82765000
      << Deallocate the transport service. >>                           82770000
                                                                        82775000
      b08'network'protocol(control'table,                               82780000
          transport'deallocate, 0, 0,                                   82785000
          control'table(ct'cds'dst'num),ldev);                          82790000
                                                                        82795000
                                                                        82800000
                                                                        82805000
      << Set up error codes and return. >>                              82810000
      transfer'log := 0;                                                82815000
                                                                        82820000
      return;                                                           82825000
    end;                                                                82830000
                                                                        82835000
  << Now calculate, from information returned by level 4    >> <<07425>>82840000
  << and the peripheral, the most efficient size for the    >> <<07425>>82845000
  << record buffer areas.  Tests have shown that it is      >> <<07425>>82850000
  << more efficient to shrink the record size by up to as   >> <<07425>>82855000
  << much as 25% than it is to send multiple packets.  This >> <<07425>>82860000
  << is due to the fact that shrinking the record will only >> <<07425>>82865000
  << cause an extra record to be sent every 4th to 6th re-  >> <<07425>>82870000
  << cord, where sending extra packets occurs on every re-  >> <<07425>>82875000
  << cord.  Hence, on a link such as MTS, line turnarounds  >> <<07425>>82880000
  << will occur at a 5:4 or 6:5 ratio if the record size is >> <<07425>>82885000
  << reduced, vs. a 2:1 ratio if multiple packets are sent. >> <<07425>>82890000
                                                               <<07425>>82895000
  usable'packet'space :=                                       <<07425>>82900000
      cb'info(packet'size)                                     <<07425>>82905000
      - ( cb'info(packet'header'size) to'byte )                <<07425>>82910000
      - ( cb'info(packet'trailer'size) to'byte );              <<07425>>82915000
                                                               <<07425>>82920000
  if cb'info(device'buffer'size) > usable'packet'space then    <<07425>>82925000
    begin                                                      <<07425>>82930000
                                                               <<07425>>82935000
      << It won't all fit in one packet, so calculate how   >> <<07425>>82940000
      << much is left over after an integral number of      >> <<07425>>82945000
      << packets have been used.                            >> <<07425>>82950000
      remainder := cb'info(device'buffer'size)                 <<07425>>82955000
                   mod usable'packet'space;                    <<07425>>82960000
                                                               <<07425>>82965000
      << if the remainder is less than 25% of the record  >>   <<07425>>82970000
      << size, shrink the record so it fits into an inte- >>   <<07425>>82975000
      << gral number of packets.                          >>   <<07425>>82980000
      if remainder < ( cb'info(device'buffer'size) / 4 ) then  <<07425>>82985000
        begin                                                  <<07425>>82990000
                                                               <<07425>>82995000
          << Shrink the record to eliminate the remainder >>   <<07425>>83000000
          cb'info(device'buffer'size) :=                       <<07425>>83005000
              cb'info(device'buffer'size) - remainder;         <<07425>>83010000
                                                               <<07425>>83015000
          << Round result down to even number of bytes >>      <<07425>>83020000
          cb'info(device'buffer'size).bit'15 := 0;             <<07425>>83025000
                                                               <<07425>>83030000
        end;                                                   <<07425>>83035000
                                                               <<07425>>83040000
    end;                                                       <<07425>>83045000
<< CALCULATE FROM THE LEVEL DATA AND THE DEVICE INFO THE >>    <<07425>>83050000
<< MOST EFFICENT BUFFER SIZE. TEST DATA INDICATE THAT IT >>    <<07425>>83055000
<< IS MORE EFFICENT TO SHRINK THE REC SIZE BY AS MUCH AS >>    <<07425>>83060000
<< 25% RATHER THAN SEND MULTIPLE PACKETS. ASK BOISE FOR  >>    <<07425>>83065000
<< DETAILS.                                              >>    <<07425>>83070000
USABLE'PACKET'SPACE :=                                         <<07425>>83075000
   CB'INFO(PACKET'SIZE) -                                      <<07425>>83080000
   (CB'INFO(PACKET'HEADER'SIZE) TO'BYTE) -                     <<07425>>83085000
   (CB'INFO(PACKET'TRAILER'SIZE) TO'BYTE);                     <<07425>>83090000
                                                               <<07425>>83095000
IF CB'INFO(DEVICE'BUFFER'SIZE) > USABLE'PACKET'SPACE THEN      <<07425>>83100000
   BEGIN                                                       <<07425>>83105000
   << WILL NOT FIT IN ONE PACKET, CALC. SPILLOVER >>           <<07425>>83110000
   REMAINDER := CB'INFO(DEVICE'BUFFER'SIZE) MOD                <<07425>>83115000
                USABLE'PACKET'SPACE;                           <<07425>>83120000
   << IF REMAINDER < 25% THEN SHRINK RECORD SIZE >>            <<07425>>83125000
   IF REMAINDER < (CB'INFO(DEVICE'BUFFER'SIZE) / 4) THEN       <<07425>>83130000
      BEGIN << SHRINKAGE >>                                    <<07425>>83135000
      CB'INFO(DEVICE'BUFFER'SIZE) :=                           <<07425>>83140000
         CB'INFO(DEVICE'BUFFER'SIZE) - REMAINDER;              <<07425>>83145000
      << ROUND DOWN TO EVEN BYTE COUNT >>                      <<07425>>83150000
      CB'INFO(DEVICE'BUFFER'SIZE).BIT'15 := 0;                 <<07425>>83155000
      END;                                                     <<07425>>83160000
END;                                                           <<07425>>83165000
  << Save the address of the temporary area >>                          83170000
                                                                        83175000
  cb'info(temp'area) := cb'info(cds'area'base);                         83180000
                                                                        83185000
                                                                        83190000
  << Set the free'buff'list head, o'r'base, and     >>                  83195000
  << i'r'base pointers to nil, since they will not  >>                  83200000
  << be valid until init'cds'area is finished.      >>                  83205000
                                                                        83210000
  cb'info(free'buff'list) := nil;                                       83215000
  cb'info(o'r'base) := nil;                                             83220000
  cb'info(i'r'base) := nil;                                             83225000
                                                                        83230000
                                                                        83235000
  << Initialize the new cds area.  All record buf-  >>                  83240000
  << fers and status tanks will be built, and       >>                  83245000
  << cb'info will be updated accordingly.           >>                  83250000
                                                                        83255000
  init'cds'area( cb'info(cds'area'base)                                 83260000
                ,5  << # of record buffer areas >>  );                  83265000
                                                                        83270000
                                                                        83275000
  << Now that we are done with it, release the temp- >>                 83280000
  << porary area of the CIPER data segment.          >>                 83285000
                                                                        83290000
  @release'ptr := cb'info(temp'area);                                   83295000
  cpr'rel'cds'area(release'ptr);                                        83300000
  cb'info(temp'area) := nil;                                            83305000
                                                                        83310000
  << If we have gotten this far, the CIPER data seg- >>                 83315000
  << ment is initialized, so mark the initialized    >>                 83320000
  << flag true.                                      >>                 83325000
                                                                        83330000
  cb'info(initialized) := true;                                         83335000
                                                               <<04422>>83340000
                                                               <<04422>>83345000
  << Prime the status area by explicitly asking for a device >><<04422>>83350000
  << status report.  If one has already come in during the   >><<04422>>83355000
  << device clear sequence, no harm will be done in asking   >><<04422>>83360000
  << for another.                                            >><<04422>>83365000
                                                               <<04422>>83370000
  b08'buf'device'status( cb'info, 0, 0, 0, immediate );        <<04422>>83375000
                                                               <<04422>>83380000
                                                                        83385000
  << Set status return to indicate successful completion >>             83390000
                                                                        83395000
  return'status := no'errors;                                           83400000
                                                                        83405000
                                                                        83410000
end;  << of procedure b08'initialize >>                                 83415000
                                                                        83420000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR"                                     83425000
double procedure b08'logical'dvr( ldev, qmisc, dst'num,                 83430000
                                  address, function, count,             83435000
                                  parm1, parm2, flags       );          83440000
                                                                        83445000
  value                           ldev, qmisc, dst'num,                 83450000
                                  address, function, count,             83455000
                                  parm1, parm2, flags        ;          83460000
                                                                        83465000
  integer                         ldev, qmisc, dst'num,                 83470000
                                  address, function, count,             83475000
                                  parm1, parm2, flags        ;          83480000
                                                                        83485000
  option privileged, uncallable                              ;          83490000
                                                                        83495000
                                                                        83500000
COMMENT                                                                 83505000
                                                                        83510000
  PURPOSE:                                                              83515000
                                                                        83520000
    This procedure performs the functions of the CIPER logical          83525000
    driver.  Its implementation is specific to the 2608B line           83530000
    printer, however, it has been designed with the intention           83535000
    of expanding it to support the Hickory and Aspen printer            83540000
    families, as well as other future CIPER devices.                    83545000
                                                                        83550000
                                                                        83555000
  INPUT PARAMETERS:                                                     83560000
                                                                        83565000
    LDEV, the Logical DEVice number of the desired peripheral,          83570000
                                                                        83575000
    QMISC, a miscellaneous device dependent parameter,                  83580000
                                                                        83585000
    DST'NUM, which is the DST number (or zero) where the                83590000
      caller's data is located,                                         83595000
                                                                        83600000
    ADDRESS, which is the offset within a DST of the caller's           83605000
      data, or an index to a system buffer,                             83610000
                                                                        83615000
    FUNCTION, which is the function code requested by the               83620000
      caller,                                                           83625000
                                                                        83630000
    COUNT, which is a count (word or byte) describing the               83635000
      length of the caller's data buffer,                               83640000
                                                                        83645000
    PARM1, which is a request dependent flag,                           83650000
                                                                        83655000
    PARM2, which is also a request dependent flag,                      83660000
                                                                        83665000
    FLAGS, which are control and specification flags.                   83670000
                                                                        83675000
                                                                        83680000
  OUTPUT PARAMETERS:                                                    83685000
                                                                        83690000
    B08'LOGICAL'DVR is a DOUBLE procedure, and as such, returns         83695000
    the following information encoded in a double word:                 83700000
                                                                        83705000
    PCB'NUM, which is the PCB number of the calling program,            83710000
                                                                        83715000
    STATUS, which is the completion status and consists of a            83720000
      qualifier and general status fields,                              83725000
                                                                        83730000
    TRANSMISSION'LOG, which is a count of the data actually             83735000
      transferred as a result of this call.  May be in words            83740000
      (positive) or bytes (negative) depending on sense of              83745000
      COUNT parameter.                                                  83750000
                                                                        83755000
                                                                        83760000
  SIDE-EFFECTS:                                                         83765000
                                                                        83770000
    B08'LOGICAL'DVR will modify the input/output data buffers           83775000
    in the CIPER data segment.  Auxilliary information in the           83780000
    CIPER DST which describes the condition of the input/output         83785000
    buffers, peripheral state, and transport service state may          83790000
    be modified as required.                                            83795000
                                                                        83800000
                                                                        83805000
  SPECIAL CONSIDERATIONS:                                               83810000
                                                                        83815000
    When called, DB can be pointing to any data segment or the          83820000
    caller's stack (typical).  B08'logical'dvr will set DB to           83825000
    several other DST's, most notably the CIPER data segment,           83830000
    the LPDT segment, and possibly SYSGLOB.  Before returning           83835000
    to the caller, b08'logical'dvr will restore DB to the data          83840000
    segment the call was made upon.                                     83845000
                                                                        83850000
                                                                        83855000
  CHANGE HISTORY:                                                       83860000
                                                                        83865000
    8/31/83  Chuck Mayne                                       <<07425>>83870000
                                                               <<07425>>83875000
    Added function codes 250 and 251 (enable logging and dis-  <<07425>>83880000
    able logging, respectfully).  This only execute if the     <<07425>>83885000
    diagnostic request bit of FLAGS is set.                    <<07425>>83890000
                                                               <<07425>>83895000
    Modified the driver call and driver exit logging routines. <<07425>>83900000
    These now make separate log entries, where before it was   <<07425>>83905000
    a single entry.                                            <<07425>>83910000
                                                                        83915000
;                                                                       83920000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR -- LOCAL VARIABLES"                  83925000
begin                                                                   83930000
                                                                        83935000
                                                                        83940000
  logical                                                               83945000
                                                                        83950000
    exit'label'saved                                                    83955000
      << Saves exit label address in case we need it during >>          83960000
      << a cpr'shutdown.                                    >>          83965000
                                                                        83970000
  ;                                                                     83975000
                                                                        83980000
                                                                        83985000
  double                                                                83990000
                                                                        83995000
    callers'db                                                          84000000
      << Saves the DB that the caller was on upon entry >>              84005000
                                                                        84010000
  ;                                                                     84015000
                                                                        84020000
                                                                        84025000
  << CONTROL TABLE DEFINITIONS >>                                       84030000
                                                                        84035000
  logical pointer                                                       84040000
                                                                        84045000
    control'table                                                       84050000
      << points to base of control table for a particular >>            84055000
      << logical device                                   >>            84060000
                                                                        84065000
  ;                                                                     84070000
                                                                        84075000
                                                                        84080000
  integer                                                               84085000
                                                                        84090000
    callers'stk'db                                                      84095000
      << Contains DB offset from base of stack dst, if    >>            84100000
      << source of caller's data is the stack.            >>            84105000
                                                                        84110000
  ;                                                                     84115000
                                                                        84120000
                                                                        84125000
  << Declarations required for NO-WAIT I/O >>                           84130000
                                                                        84135000
  double                                                                84140000
                                                                        84145000
    current'dst                                                         84150000
      << Used by ChangeDB to save dst number that we are >>             84155000
      << leaving.                                        >>             84160000
                                                                        84165000
  ;                                                                     84170000
                                                                        84175000
  logical                                                               84180000
                                                                        84185000
    called'on'stack                                                     84190000
      << set to true if dst'num reflects a stack dst, false >>          84195000
      << otherwise (XDS or SBUF)                            >>          84200000
                                                                        84205000
  ;                                                                     84210000
                                                                        84215000
                                                                        84220000
  integer                                                      <<07425>>84225000
                                                               <<07425>>84230000
    IOQ'ENTRY'INDEX  << IOQ TABLE INDEX >>                     <<07425>>84235000
      << contains SYSDB relative IOQ address >>                <<07425>>84240000
                                                               <<07425>>84245000
                                                               <<07425>>84250000
                                                               <<07425>>84255000
                                                               <<07425>>84260000
                                                               <<07425>>84265000
                                                               <<07425>>84270000
    ;                                                          <<07425>>84275000
                                                                        84280000
                                                                        84285000
                                                               <<07425>>84290000
                                                                        84295000
                                                               <<07425>>84300000
                                                                        84305000
                                                               <<07425>>84310000
                                                                        84315000
                                                               <<07425>>84320000
                                                                        84325000
                                                               <<07425>>84330000
                                                                        84335000
                                                               <<07425>>84340000
                                                                        84345000
                                                               <<07425>>84350000
                                                                        84355000
                                                               <<07425>>84360000
                                                                        84365000
                                                               <<07425>>84370000
                                                                        84375000
                                                               <<07425>>84380000
                                                                        84385000
                                                               <<07425>>84390000
                                                                        84395000
                                                               <<07425>>84400000
                                                                        84405000
                                                               <<07425>>84410000
                                                                        84415000
                                                               <<07425>>84420000
                                                                        84425000
                                                               <<07425>>84430000
                                                                        84435000
                                                               <<07425>>84440000
                                                                        84445000
                                                                        84450000
                                                                        84455000
  equate                                                                84460000
                                                                        84465000
    pcbb                          = 3                                   84470000
      << absolute base of process control block table >>                84475000
                                                                        84480000
   ,cpcb                          = 4                                   84485000
      << absolute address of current process control block >>           84490000
      << pointer.                                          >>           84495000
                                                                        84500000
  ;                                                                     84505000
                                                                        84510000
                                                                        84515000
  << CONTROL BLOCK DEFINITIONS >>                                       84520000
                                                                        84525000
  logical pointer                                                       84530000
                                                                        84535000
    control'block                                                       84540000
      << points to base of control block for Level 7 >>                 84545000
  ;                                                                     84550000
                                                                        84555000
                                                                        84560000
  << CONTROL BLOCK INFORMATION AREA DEFINITIONS >>                      84565000
                                                                        84570000
  integer pointer                                                       84575000
                                                                        84580000
    cb'info                                                             84585000
      << points to base of level dependent information area >>          84590000
  ;                                                                     84595000
                                                                        84600000
                                                                        84605000
  << MISCELLANEOUS VARIABLES >>                                         84610000
                                                                        84615000
                                                                        84620000
  double                                                                84625000
                                                                        84630000
    return'information            = b08'logical'dvr                     84635000
      << Used for completion status from all procedure   >>             84640000
      << calls.  First word is status, second word is    >>             84645000
      << transfer count (if appropriate).                >>             84650000
                                                                        84655000
  ;                                                                     84660000
                                                                        84665000
  integer                                                               84670000
                                                                        84675000
    return'status                 = return'information                  84680000
      << used for error checking from other procedures >>               84685000
                                                                        84690000
   ,transfer'log                  = return'information + 1              84695000
      << Transfer count or auxilliary information >>                    84700000
                                                                        84705000
  ;                                                                     84710000
                                                               <<04422>>84715000
                                                               <<04422>>84720000
  logical                                                      <<04422>>84725000
                                                               <<04422>>84730000
    saved'critical'value                                       <<04422>>84735000
      << Saves value returned from setcritical call.  Used >>  <<04422>>84740000
      << when calling resetcritical.                       >>  <<04422>>84745000
                                                               <<04422>>84750000
  ;                                                            <<04422>>84755000
                                                                        84760000
                                                                        84765000
                                                                        84770000
  define                                                                84775000
                                                                        84780000
    translate                     = true #                              84785000
      << indicates cpr'xlate should convert function codes >>           84790000
      << to escape sequences                               >>           84795000
                                                                        84800000
   ,no'translate                  = false #                             84805000
      << indicates cpr'xlate should not be used to convert >>           84810000
      << MPE function codes into device escape sequences   >>           84815000
                                                                        84820000
  ;                                                                     84825000
                                                                        84830000
                                                                        84835000
                                                                        84840000
$IF X7 = ON  << ON = LOGGING, OFF = NO LOGGING >>                       84845000
                                                                        84850000
  << Variables used for performance logging >>                          84855000
                                                                        84860000
  double                                                                84865000
                                                                        84870000
    entry'time                                                          84875000
      << Saves timer count at entry to logical driver >>                84880000
                                                                        84885000
  ;                                                                     84890000
                                                                        84895000
  integer array                                                         84900000
                                                                        84905000
    qm15(*)                       = q-15                       <<07425>>84910000
      << points to base of parameters passed to driver >>               84915000
                                                                        84920000
  ;                                                                     84925000
                                                                        84930000
                                                                        84935000
  integer                                                               84940000
                                                                        84945000
    final'time'1                  = entry'time                          84950000
   ,final'time'2                  = entry'time + 1                      84955000
      << upper and lower words of entry'time >>                         84960000
                                                                        84965000
  ;                                                                     84970000
                                                                        84975000
                                                                        84980000
  integer pointer                                                       84985000
                                                                        84990000
    log'buffer                                                          84995000
      << points to buffer area used to assemble log  >>                 85000000
      << records before they are moved to the logging dst >>            85005000
                                                                        85010000
  ;                                                                     85015000
                                                                        85020000
                                                                        85025000
double procedure timer;                                                 85030000
                                                                        85035000
  option external, privileged;                                          85040000
                                                                        85045000
$IF                                                                     85050000
                                                                        85055000
  declare'move'from'data'segment;                                       85060000
  declare'move'to'data'segment;                                         85065000
                                                                        85070000
$IF X7 = ON  << ON = INCLUDE LOGGING >>                                 85075000
                                                               <<07425>>85080000
  declare'get'log'buffer;                                      <<07425>>85085000
                                                               <<07425>>85090000
  declare'put'le;                                              <<07425>>85095000
                                                               <<07425>>85100000
  declare'event'enabled;                                       <<07425>>85105000
                                                               <<07425>>85110000
$PAGE "PROC:  b08'logical'dvr -- SUBROUTINE:  log'driver'pcal" <<07425>>85115000
subroutine log'driver'pcal;                                    <<07425>>85120000
                                                               <<07425>>85125000
COMMENT                                                        <<07425>>85130000
                                                               <<07425>>85135000
  PURPOSE:                                                     <<07425>>85140000
                                                               <<07425>>85145000
    This subroutine will log the calling parameters and        <<07425>>85150000
    current time when the logical driver has been called.      <<07425>>85155000
                                                               <<07425>>85160000
;                                                              <<07425>>85165000
                                                               <<07425>>85170000
begin                                                          <<07425>>85175000
                                                               <<07425>>85180000
  << get the logging buffer >>                                 <<07425>>85185000
                                                               <<07425>>85190000
  @log'buffer := get'log'buffer(log'buffer);                   <<07425>>85195000
                                                               <<07425>>85200000
                                                               <<07425>>85205000
  << fill in the appropriate info >>                           <<07425>>85210000
                                                               <<07425>>85215000
  log'buffer(log'entry'type) := le'driver'entry;               <<07425>>85220000
                                                               <<07425>>85225000
  x := log'entry'data;                                         <<07425>>85230000
  do                                                           <<07425>>85235000
    begin                                                      <<07425>>85240000
      log'buffer(x) := qm15(x);                                <<07425>>85245000
      x := x + 1;                                              <<07425>>85250000
    end                                                        <<07425>>85255000
  until x = 12;                                                <<07425>>85260000
                                                               <<07425>>85265000
  log'buffer(x) := final'time'1;                               <<07425>>85270000
  log'buffer(x := x + 1) := final'time'2;                      <<07425>>85275000
                                                               <<07425>>85280000
                                                               <<07425>>85285000
  << put the log entry into the logging dst >>                 <<07425>>85290000
                                                               <<07425>>85295000
  put'le( log'buffer, 11 );                                    <<07425>>85300000
                                                               <<07425>>85305000
end;  << of subroutine log'driver'pcal >>                      <<07425>>85310000
                                                               <<07425>>85315000
                                                               <<07425>>85320000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR -- SUBROUTINE:  COMPLETE'LOG'ENTRY"  85325000
subroutine complete'log'entry;                                          85330000
                                                                        85335000
COMMENT                                                                 85340000
                                                                        85345000
  PURPOSE:                                                              85350000
                                                                        85355000
    This subroutine is called just prior to exiting the logical         85360000
    driver.  It will calculate the time spent in the driver,            85365000
    and will complete a log entry if logging is enabled for             85370000
    pcal/exit time.                                                     85375000
                                                                        85380000
                                                                        85385000
  INPUT PARAMETERS:                                                     85390000
                                                                        85395000
    None.                                                               85400000
                                                                        85405000
                                                                        85410000
  OUTPUT PARAMETERS:                                                    85415000
                                                                        85420000
    None.                                                               85425000
                                                                        85430000
                                                                        85435000
  SIDE-EFFECTS:                                                         85440000
                                                                        85445000
    None.                                                               85450000
                                                                        85455000
                                                                        85460000
  SPECIAL CONSIDERATIONS:                                               85465000
                                                                        85470000
    None.                                                               85475000
                                                                        85480000
                                                                        85485000
  CHANGE HISTORY:                                                       85490000
                                                                        85495000
    As issued.                                                          85500000
                                                                        85505000
                                                                        85510000
;                                                                       85515000
$PAGE                                                                   85520000
begin                                                                   85525000
  << Determine if logging for pcal/exit is enabled.  If it >>           85530000
  << is, then complete the log entry and put it in the log- >>          85535000
  << ging dst.                                              >>          85540000
                                                                        85545000
  if event'enabled(le'driver'exit) then                        <<07425>>85550000
    begin                                                               85555000
                                                                        85560000
      << Get the logging buffer address >>                              85565000
                                                                        85570000
      @log'buffer := get'log'buffer(log'buffer);                        85575000
                                                                        85580000
                                                                        85585000
      << Calculate the total elapsed time spent in the >>               85590000
      << driver.                                                        85595000
                                                                        85600000
      entry'time := timer;                                     <<07425>>85605000
                                                                        85610000
                                                                        85615000
      << Move all the appropriate info into the logging >>              85620000
      << buffer.                                        >>              85625000
                                                                        85630000
      log'buffer(log'entry'type) := le'driver'exit;            <<07425>>85635000
                                                                        85640000
                                                                        85645000
      log'buffer(log'entry'data) := return'status;             <<07425>>85650000
      log'buffer(x := x + 1) := transfer'log;                           85655000
                                                                        85660000
      log'buffer(x := x + 1) := final'time'1;                           85665000
      log'buffer(x := x + 1) := final'time'2;                           85670000
                                                                        85675000
                                                                        85680000
      << Now put the log entry into the log dst >>                      85685000
                                                                        85690000
      put'le( log'buffer, 4 );                                 <<07425>>85695000
                                                                        85700000
    end;                                                                85705000
                                                                        85710000
end;  << of subroutine complete'log'entry >>                            85715000
$IF                                                                     85720000
$PAGE "PROC:  B08'LOGICAL'DVR -- SUBROUTINE:  B08'MODIFY'RETURN'STATUS" 85725000
integer subroutine b08'modify'return'status( cb'info,                   85730000
                                             current'status );          85735000
                                                                        85740000
  value                                      cb'info,                   85745000
                                             current'status  ;          85750000
                                                                        85755000
  logical pointer                            cb'info         ;          85760000
                                                                        85765000
  integer                                    current'status  ;          85770000
                                                                        85775000
                                                                        85780000
COMMENT                                                                 85785000
                                                                        85790000
  PURPOSE:                                                              85795000
                                                                        85800000
    This subroutine will determine if the driver completion             85805000
    status should be modified to reflect the fact that some             85810000
    new type of status report has been received during the              85815000
    time the logical driver was active.  This subroutine will           85820000
    only modify a good completion (%1) to a %41 completion.             85825000
                                                                        85830000
                                                                        85835000
  INPUT PARAMETERS:                                                     85840000
                                                                        85845000
    CB'INFO, which points to the control block information              85850000
      area for the logical driver.  This area contains global           85855000
      information for the logical driver, including the bit             85860000
      mask that determines which types of status are to be              85865000
      reported.                                                         85870000
                                                                        85875000
    CURRENT'STATUS, which is the driver completion status that          85880000
      will be passed back to the caller.                                85885000
                                                                        85890000
                                                                        85895000
  OUTPUT PARAMETERS:                                                    85900000
                                                                        85905000
    B08'MODIFY'STATUS'RETURN, which is the completion status            85910000
      after modification (if any).                                      85915000
                                                                        85920000
                                                                        85925000
  SIDE-EFFECTS:                                                         85930000
                                                                        85935000
    The status'reported bit map contained in cb'info will be            85940000
    updated to reflect the latest status information reported           85945000
    to the caller.                                                      85950000
                                                                        85955000
                                                                        85960000
  SPECIAL CONSIDERATIONS:                                               85965000
                                                                        85970000
    None.                                                               85975000
                                                                        85980000
                                                                        85985000
  CHANGE HISTORY:                                                       85990000
                                                                        85995000
    As issued.                                                          86000000
                                                                        86005000
;                                                                       86010000
begin                                                                   86015000
                                                                        86020000
  if ((cb'info(status'enabled) land cb'info(status'received))           86025000
      land not cb'info(status'reported)) <> 0 then                      86030000
    begin                                                               86035000
                                                                        86040000
      cb'info(status'reported) :=                                       86045000
        cb'info(status'enabled) land cb'info(status'received);          86050000
                                                                        86055000
      b08'modify'return'status :=                                       86060000
        integer( logical( current'status ) lor %40 );                   86065000
                                                                        86070000
    end                                                                 86075000
  else                                                                  86080000
    begin                                                               86085000
                                                                        86090000
      b08'modify'return'status := current'status;                       86095000
                                                                        86100000
    end;                                                                86105000
                                                                        86110000
end;  << of subroutine b08'modify'return'status >>                      86115000
$PAGE "PROCEDURE: B08'LOGICAL'DVR -- SUBROUTINE: SET'STATUS'FOR'RETURN" 86120000
integer subroutine set'status'for'return;                               86125000
                                                                        86130000
COMMENT                                                                 86135000
                                                                        86140000
  PURPOSE:                                                              86145000
                                                                        86150000
    This subroutine determines if the caller specified no-wait          86155000
    I/O, and if so, allocates an IOQ to place the completion            86160000
    information into.  The SYSDB relative IOQ index is then             86165000
    passed back as the first word of the double word completion         86170000
    status.  If the caller specified blocked I/O, nothing is            86175000
    done, as the double word is already set up.                         86180000
                                                                        86185000
                                                                        86190000
  INPUT PARAMETERS:                                                     86195000
                                                                        86200000
    None.                                                               86205000
                                                                        86210000
                                                                        86215000
  OUTPUT PARAMETERS:                                                    86220000
                                                                        86225000
    None.                                                               86230000
                                                                        86235000
                                                                        86240000
  SIDE-EFFECTS:                                                         86245000
                                                                        86250000
    None.                                                               86255000
                                                                        86260000
                                                                        86265000
  SPECIAL CONSIDERATIONS:                                               86270000
                                                                        86275000
    None.                                                               86280000
                                                                        86285000
                                                                        86290000
  CHANGE HISTORY:                                                       86295000
                                                                        86300000
    As issued.                                                          86305000
                                                                        86310000
                                                                        86315000
;                                                                       86320000
                                                                        86325000
begin                                                                   86330000
                                                                        86335000
  << First, modify the return status (if the completion is >>           86340000
  << good) to reflect the receipt of any status reports    >>           86345000
                                                                        86350000
  if return'status.general = successful then                            86355000
    begin                                                               86360000
      return'status.overall := b08'modify'return'status                 86365000
            (cb'info, return'status);                                   86370000
    end;                                                                86375000
                                                                        86380000
                                                                        86385000
  << If the request type is 3 or 7, then it is unblocked >>             86390000
  << with no PCB.  This means that we return status of one, >>          86395000
  << transfer log of zero, and return any sytem buffers.    >>          86400000
                                                                        86405000
  if flags.request'type = 3                                             86410000
  or flags.request'type = 7                                             86415000
  then                                                                  86420000
    begin                                                               86425000
      return'status := 1;                                               86430000
      transfer'log := 0;                                                86435000
      if (flags.system'buffers = 1) and (address <> 0) then             86440000
        begin                                                           86445000
          current'dst := changedb(sysdb);                      <<07425>>86450000
          returnsysbuf(address);                                        86455000
          changedb(current'dst);                               <<07425>>86460000
        end;                                                            86465000
    end                                                                 86470000
  else                                                                  86475000
    begin                                                               86480000
                                                                        86485000
      << Next, check to see if no-wait I/O was specified >>             86490000
                                                                        86495000
      if flags.request'type <> blocked then                             86500000
        begin                                                           86505000
          << First, we must change DB to SYSDB >>                       86510000
                                                                        86515000
          current'dst := changedb(sysdb);                      <<07425>>86520000
                                                                        86525000
          << Get an IOQ from the primary table, impeding if >>          86530000
          << none are available.                            >>          86535000
                                                                        86540000
          IOQ'ENTRY'INDEX := getioq(0);                        <<07425>>86545000
                                                                        86550000
          << Move in all of the appropriate information >>              86555000
          << Plugging %1000 into the flags word of the IOQ >>           86560000
          << sets the completed bit.  Word 0 is flags.     >>           86565000
                                                                        86570000
          IOQ'FLAGS := %1000;                                  <<07425>>86575000
                                                                        86580000
          IOQ'SBUF := flags.system'buffers;                    <<07425>>86585000
          IOQ'IOWAKE := flags.wake'bit;                        <<07425>>86590000
          IOQ'QLINK := 0;                                      <<07425>>86595000
          IOQ'LDEV := ldev;                                    <<07425>>86600000
          IOQ'QMISC := qmisc;                                  <<07425>>86605000
          IOQ'BUF'DSTN := dst'num;                             <<07425>>86610000
          IOQ'DBREL := called'on'stack;                        <<07425>>86615000
          IOQ'BUFADR := address;                               <<07425>>86620000
          IOQ'FUNC := function;                                <<07425>>86625000
          IOQ'COUNT := transfer'log;                           <<07425>>86630000
          IOQ'PARM1 := parm1;                                  <<07425>>86635000
          IOQ'PARM2 := parm2;                                  <<07425>>86640000
          IOQ'STAT := return'status;                           <<07425>>86645000
                                                                        86650000
          << Modify the return information so it points to  >>          86655000
          << the IOQ just obtained.                         >>          86660000
                                                                        86665000
          return'status := IOQ'ENTRY'INDEX;                    <<07425>>86670000
          transfer'log := 0;                                            86675000
                                                                        86680000
          << Now return to the CIPER data segment >>                    86685000
                                                                        86690000
          changedb(current'dst);                               <<07425>>86695000
                                                                        86700000
        end;                                                            86705000
    end;                                                                86710000
                                                                        86715000
                                                                        86720000
  << If logging is enabled, complete the pcal/exit log entry >>         86725000
                                                                        86730000
$IF X7 = ON  << ON = LOGGING, OFF = NO LOGGING >>                       86735000
                                                                        86740000
  if @control'table is'not'nil then complete'log'entry;                 86745000
                                                                        86750000
$IF                                                                     86755000
                                                                        86760000
                                                                        86765000
  << Now change back to the caller's dst >>                             86770000
                                                                        86775000
  if @control'table is'not'nil then                                     86780000
    begin                                                               86785000
                                                                        86790000
      cpr'rel'ct(control'table, callers'db);                            86795000
                                                                        86800000
    end;                                                                86805000
                                                                        86810000
                                                                        86815000
end;  << of subroutine set'status'for'return >>                         86820000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR -- PROCEDURE BODY"                   86825000
  << Save entry time for later logging, if enabled >>                   86830000
                                                                        86835000
$IF X7 = ON  << LOGGING: ON = DO IT, OFF = NO LOGGING >>                86840000
  entry'time := timer;                                                  86845000
$IF                                                                     86850000
                                                                        86855000
                                                                        86860000
  << Make sure there is enough room on the stack for all of >> <<04422>>86865000
  << CIPER's local variables, as well as the rest of the IO >> <<04422>>86870000
  << system.  If there is, setcritical so we cannot get     >> <<04422>>86875000
  << aborted (which could leave behind a dirty CDS).        >> <<04422>>86880000
                                                               <<04422>>86885000
  assemble ( adds 255;   << Our stack space requirements >>    <<04422>>86890000
             adds 255;   << I/O system's requirements    >>    <<04422>>86895000
             subs 255;   << If we didn't trap, drop the  >>    <<04422>>86900000
             subs 255    << stack back.                  >>    <<04422>>86905000
           );                                                  <<04422>>86910000
                                                               <<04422>>86915000
  saved'critical'value := setcritical;                         <<04422>>86920000
                                                               <<04422>>86925000
                                                               <<04422>>86930000
  << TURN OFF INTERNAL TRAPS >>                                         86935000
                                                                        86940000
  Turnofftraps;                                                         86945000
                                                                        86950000
                                                                        86955000
  << Save the label address of the end of the procedure >>              86960000
  << in case the shutdown procedure needs it.           >>              86965000
                                                                        86970000
  exit'label'saved := @exit'label;                                      86975000
                                                                        86980000
                                                                        86985000
  << Get on the caller's stack as a reference point for >>              86990000
  << cpr'get'ct'of to use.                              >>              86995000
                                                                        87000000
  callers'db := changedb( 0D );                                <<07425>>87005000
                                                                        87010000
                                                                        87015000
  << Determine if the caller gave us the stack, an extra  >>            87020000
  << data segment, or a system buffer as the source of    >>            87025000
  << the data to be sent.                                 >>            87030000
                                                                        87035000
  if not logical( flags.system'buffers ) then                           87040000
    begin                                                               87045000
      << It's not system buffers, so determine if stack or >>           87050000
      << an extra data segment.  If it is the stack, then  >>           87055000
      << we need the dst number and an adjustment for the  >>           87060000
      << DB offset.                                        >>           87065000
                                                                        87070000
      if dst'num = 0 then                                               87075000
        begin                                                           87080000
          << On the stack >>                                            87085000
                                                                        87090000
          called'on'stack := true;                                      87095000
      DST'NUM := LPCB(CURPRC + STKINFOWORDNUM).STKDSTFIELD;    <<07425>>87100000
          mfds(callers'stk'db, dst'num, 1, 1);                          87105000
          address := address + callers'stk'db;                          87110000
        end                                                             87115000
      else                                                              87120000
        begin                                                           87125000
          called'on'stack := false;                                     87130000
        end;                                                            87135000
    end                                                                 87140000
  else                                                                  87145000
    begin                                                               87150000
      called'on'stack := false;                                         87155000
    end;                                                                87160000
                                                                        87165000
                                                                        87170000
  << Get the pointer to the control table for this logical >>           87175000
  << device (also switches DB to the CIPER data segment).  >>           87180000
                                                                        87185000
  @control'table := nil;                                                87190000
  @control'table := cpr'get'ct'of(ldev, callers'db);                    87195000
                                                                        87200000
  << check to make sure we were able to get into the control >>         87205000
  << table.  If we couldn't, it is a fatal error.            >>         87210000
                                                                        87215000
  if @control'table = nil then                                          87220000
    begin                                                               87225000
      << Do nothing but die >>                                          87230000
                                                                        87235000
      cpr'internal'error;                                               87240000
    end;                                                                87245000
                                                                        87250000
  << The following check is for spooler debugging. >>                   87255000
                                                                        87260000
  if @control'table < nil then                                          87265000
    begin                                                               87270000
      @control'table := -@control'table;                                87275000
      debug;                                                            87280000
    end;                                                                87285000
                                                                        87290000
                                                                        87295000
  << Get the pointer to the control block for this level. >>            87300000
                                                                        87305000
  @control'block := cpr'cb'of(control'table,7);                         87310000
                                                                        87315000
  cpr'assertion(@control'block <> nil);                                 87320000
                                                                        87325000
                                                                        87330000
  << Now check the information area pointer of the control >>           87335000
  << block.  If it is zero, we have never initialized.     >>           87340000
                                                                        87345000
  if control'block(cb'info'ptr) = nil then                              87350000
    begin                                                               87355000
      << There is no level dependent information area for  >>           87360000
      << this device, so we must need to initialize.       >>           87365000
                                                                        87370000
      @cb'info := cpr'init'cbi(control'block,cb'info'size);             87375000
                                                                        87380000
      return'information :=                                             87385000
        b08'initialize( control'table,                                  87390000
                        control'block,                                  87395000
                        cb'info,                                        87400000
                        ldev              );                            87405000
                                                                        87410000
      if return'status <> no'errors then                                87415000
        begin                                                           87420000
                                                                        87425000
          << Clean up so next call can try again >>                     87430000
                                                                        87435000
          control'block(cb'info'ptr) := nil;                            87440000
                                                                        87445000
          if cb'info(cds'area'base) <> nil then                         87450000
            begin                                                       87455000
              @control'block := cb'info(cds'area'base);                 87460000
              cpr'rel'cds'area(control'block);                          87465000
            end;                                                        87470000
                                                                        87475000
          if cb'info(temp'area) <> cb'info(cds'area'base)               87480000
          and cb'info(temp'area) <> nil then                            87485000
            begin                                                       87490000
              @control'block := cb'info(temp'area);                     87495000
              cpr'rel'cds'area(control'block);                          87500000
            end;                                                        87505000
                                                                        87510000
          cpr'rel'cds'area(cb'info);                                    87515000
                                                                        87520000
          go to exit'label;                                    <<04422>>87525000
                                                                        87530000
        end;                                                            87535000
                                                                        87540000
                                                                        87545000
                                                                        87550000
    end   << of if cb'info'ptr = 0 ... >>                               87555000
  else                                                                  87560000
    begin                                                               87565000
      << There is a cb'info area set aside, so set up  >>               87570000
      << the pointer, then check to make sure it was   >>               87575000
      << properly initialized.                         >>               87580000
                                                                        87585000
                                                                        87590000
      @cb'info := control'block(cb'info'ptr);                           87595000
                                                                        87600000
      << Check the initialization flag. >>                              87605000
                                                                        87610000
      if not logical(cb'info(initialized)) then                         87615000
        begin                                                           87620000
          << Cb'info was allocated but not completely init- >>          87625000
          << ialized, so an error must have occurred then.  >>          87630000
          << We cannot do anything but die.                 >>          87635000
                                                                        87640000
          cpr'internal'error;                                           87645000
        end;                                                            87650000
                                                                        87655000
    end;  << of if cb'info'ptr <> 0 >>                                  87660000
                                                               <<07425>>87665000
                                                               <<07425>>87670000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>87675000
                                                               <<07425>>87680000
  cb'info(dvr'seq) := cb'info(dvr'seq)                         <<07425>>87685000
                               + 1;                            <<07425>>87690000
                                                               <<07425>>87695000
  if event'enabled(le'driver'entry) then                       <<07425>>87700000
    begin                                                      <<07425>>87705000
      log'driver'pcal;                                         <<07425>>87710000
    end;                                                       <<07425>>87715000
                                                               <<07425>>87720000
$IF                                                            <<07425>>87725000
                                                                        87730000
                                                                        87735000
  << Now decide if the composite status area should be    >>            87740000
  << cleared.  Normally it is at the start of each call   >>            87745000
  << to the logical driver, but if this is a call to re-  >>            87750000
  << turn that information, then obviously we shouldn't   >>            87755000
  << clear it.                                            >>            87760000
                                                                        87765000
  if logical( cb'info(comp'stat'available) )                            87770000
  and function <> read'avail'status'types                      <<04422>>87775000
  and function <> environmental'status                         <<04422>>87780000
  and function <> device'status'composite then                          87785000
    begin                                                               87790000
                                                                        87795000
      b08'clean'comp'status( cb'info );                                 87800000
                                                                        87805000
    end;                                                                87810000
                                                                        87815000
                                                                        87820000
  << We are now ready to process the caller's request.  >>              87825000
  << Hash the function code into a small contiguous set >>              87830000
  << and select the appropriate case.                   >>              87835000
                                                                        87840000
  case b08'hash'function'code(function) of                              87845000
    begin                                                               87850000
                                                                        87855000
<< ----- invalid function code.  set completion code as such >>         87860000
<<>>                                                                    87865000
<<>>  begin                                                             87870000
<<>>    return'status := invalid'request;                               87875000
<<>>    transfer'log := 0;                                              87880000
<<>>  end;                                                              87885000
<<>>                                                                    87890000
<< --------------------------------------------------------- >>         87895000
                                                                        87900000
                                                                        87905000
                                                                        87910000
                                                                        87915000
<< ----- read data -- function = 0 ---------------------[ 1] >>         87920000
<<>>                                                                    87925000
<<>>  begin                                                             87930000
<<>>                                                                    87935000
<<>>    return'information :=                                           87940000
<<>>        b08'read'data( cb'info,                                     87945000
<<>>                       dst'num,                                     87950000
<<>>                       address,                                     87955000
<<>>                       count,                                       87960000
<<>>                       parm1,                                       87965000
<<>>                       parm2,                                       87970000
<<>>                       flags     );                                 87975000
<<>>                                                                    87980000
<<>>  end;                                                              87985000
<<>>                                                                    87990000
<< --------------------------------------------------------- >>         87995000
                                                                        88000000
                                                                        88005000
                                                                        88010000
                                                                        88015000
<< ----- write data -- function = 1 --------------------[ 2] >>         88020000
<<>>                                                                    88025000
<<>>  begin                                                             88030000
<<>>                                                                    88035000
<<>>    return'information :=                                           88040000
<<>>        b08'write'data(cb'info,                                     88045000
<<>>                       dst'num,                                     88050000
<<>>                       address,                                     88055000
<<>>                       function,                                    88060000
<<>>                       count,                                       88065000
<<>>                       parm1,                                       88070000
<<>>                       parm2,                                       88075000
<<>>                       flags,                                       88080000
<<>>                       user'data'with'mask,                         88085000
<<>>                       cb'info(expanded'features),                  88090000
<<>>                       translate                    );              88095000
<<>>                                                                    88100000
<<>>  end;                                                              88105000
<<>>                                                                    88110000
<< --------------------------------------------------------- >>         88115000
                                                                        88120000
                                                                        88125000
                                                                        88130000
                                                                        88135000
<< ----- file'open -- function = 2 ---------------------[ 3] >>         88140000
<<>>                                                                    88145000
<<>>  begin                                                             88150000
<<>>                                                                    88155000
<<>>    return'information := b08'file'open( cb'info );                 88160000
<<>>                                                                    88165000
<<>>  end;                                                              88170000
<<>>                                                                    88175000
<< --------------------------------------------------------- >>         88180000
                                                                        88185000
                                                                        88190000
                                                                        88195000
                                                                        88200000
<< ----- file'close -- function = 3 --------------------[ 4] >>         88205000
<<>>                                                                    88210000
<<>>  begin                                                             88215000
<<>>                                                                    88220000
<<>>    return'information :=                                           88225000
<<>>        b08'write'data( cb'info,                                    88230000
<<>>                        0,                                          88235000
<<>>                        0,                                          88240000
<<>>                        function,                                   88245000
<<>>                        0,                                          88250000
<<>>                        parm1,                                      88255000
<<>>                        parm2,                                      88260000
<<>>                        flags,                                      88265000
<<>>                        user'data'with'mask,                        88270000
<<>>                        true,                                       88275000
<<>>                        translate                  );               88280000
<<>>                                                                    88285000
<<>>    if return'status = no'errors then                               88290000
<<>>      begin                                                         88295000
<<>>                                                                    88300000
<<>>        b08'network'protocol( control'table,                        88305000
<<>>                              transport'close,                      88310000
<<>>                              0,                                    88315000
<<>>                              0,                                    88320000
<<>>                              cb'info(ciper'dst),                   88325000
<<>>                              ldev                );                88330000
<<>>                                                                    88335000
<<>>      end;                                                          88340000
<<>>                                                                    88345000
<<>>    cb'info(file'open'count) := cb'info(file'open'count)            88350000
<<>>                              - 1;                                  88355000
<<>>                                                                    88360000
<<>>    transfer'log := count;                                          88365000
<<>>                                                                    88370000
<<>>  end;                                                              88375000
<<>>                                                                    88380000
<< --------------------------------------------------------- >>         88385000
                                                                        88390000
                                                                        88395000
                                                                        88400000
                                                                        88405000
<< ----- device close -- function = 4 ------------------[ 5] >>         88410000
<<>>                                                                    88415000
<<>>  begin                                                             88420000
<<>>                                                                    88425000
<<>>    return'information := b08'device'close(cb'info);                88430000
<<>>                                                                    88435000
<<>>  end;                                                              88440000
<<>>                                                                    88445000
<< --------------------------------------------------------- >>         88450000
                                                                        88455000
                                                                        88460000
                                                                        88465000
                                                                        88470000
<< ----- device status immediate -- function = 15 ------[ 6] >>         88475000
<<>>                                                                    88480000
<<>>  begin                                                             88485000
<<>>                                                                    88490000
<<>>    return'information :=                                           88495000
<<>>        b08'buf'device'status( cb'info                              88500000
<<>>                              ,dst'num                              88505000
<<>>                              ,address                              88510000
<<>>                              ,count                                88515000
<<>>                              ,immediate );                         88520000
<<>>                                                                    88525000
<<>>  end;                                                              88530000
<<>>                                                                    88535000
<< --------------------------------------------------------- >>         88540000
                                                                        88545000
                                                                        88550000
                                                                        88555000
                                                                        88560000
<< ----- vfu download -- function = 64 -----------------[ 7] >>         88565000
<<>>                                                                    88570000
<<>>  begin                                                             88575000
<<>>                                                                    88580000
<<>>    return'information :=                                           88585000
<<>>        b08'write'data( cb'info,                                    88590000
<<>>                        dst'num,                                    88595000
<<>>                        address,                                    88600000
<<>>                        function,                                   88605000
<<>>                        count,                                      88610000
<<>>                        parm1,                                      88615000
<<>>                        parm2,                                      88620000
<<>>                        flags,                                      88625000
<<>>                        user'data'with'mask,                        88630000
<<>>                        true,                                       88635000
<<>>                        translate            );                     88640000
<<>>                                                                    88645000
<<>>  end;                                                              88650000
<<>>                                                                    88655000
<< --------------------------------------------------------- >>         88660000
                                                                        88665000
                                                                        88670000
                                                                        88675000
                                                                        88680000
<< ----- set left margin -- function = 65 --------------[ 8] >>         88685000
<<>>                                                                    88690000
<<>>  begin                                                             88695000
<<>>                                                                    88700000
<<>>    return'information :=                                           88705000
<<>>        b08'write'data(cb'info,                                     88710000
<<>>                       dst'num,                                     88715000
<<>>                       address,                                     88720000
<<>>                       function,                                    88725000
<<>>                       0, << count >>                               88730000
<<>>                       parm1,                                       88735000
<<>>                       parm2,                                       88740000
<<>>                       flags,                                       88745000
<<>>                       user'data'with'mask,                         88750000
<<>>                       true,                                        88755000
<<>>                       translate                    );              88760000
<<>>                                                                    88765000
<<>>  end;                                                              88770000
<<>>                                                                    88775000
<< --------------------------------------------------------- >>         88780000
                                                                        88785000
                                                                        88790000
                                                                        88795000
                                                                        88800000
<< ----- buffered device status -- function = 71 -------[ 9] >>         88805000
<<>>                                                                    88810000
<<>>  begin                                                             88815000
<<>>                                                                    88820000
<<>>    return'information :=                                           88825000
<<>>        b08'buf'device'status( cb'info,                             88830000
<<>>                               dst'num,                             88835000
<<>>                               address,                             88840000
<<>>                               count,                               88845000
<<>>                               buffered   );                        88850000
<<>>                                                                    88855000
<<>>  end;                                                              88860000
<<>>                                                                    88865000
<< --------------------------------------------------------- >>         88870000
                                                                        88875000
                                                                        88880000
                                                                        88885000
                                                                        88890000
<< ----- initiate self test -- function 73 -------------[10] >>         88895000
<<>>                                                                    88900000
<<>>  begin                                                             88905000
<<>>                                                                    88910000
<<>>    return'information :=                                           88915000
<<>>        b08'write'data(cb'info,                                     88920000
<<>>                       dst'num,                                     88925000
<<>>                       address,                                     88930000
<<>>                       function,                                    88935000
<<>>                       0, << count >>                               88940000
<<>>                       parm1,                                       88945000
<<>>                       parm2,                                       88950000
<<>>                       flags,                                       88955000
<<>>                       user'data'with'mask,                         88960000
<<>>                       true,                                        88965000
<<>>                       translate                    );              88970000
<<>>                                                                    88975000
<<>>  end;                                                              88980000
<<>>                                                                    88985000
<< --------------------------------------------------------- >>         88990000
                                                                        88995000
                                                                        89000000
                                                                        89005000
                                                                        89010000
<< ----- select character set -- function = 128 --------[11] >>         89015000
<<>>                                                                    89020000
<<>>  begin                                                             89025000
<<>>                                                                    89030000
<<>>    return'information :=                                           89035000
<<>>        b08'write'data(cb'info,                                     89040000
<<>>                       dst'num,                                     89045000
<<>>                       address,                                     89050000
<<>>                       function,                                    89055000
<<>>                       0, << count >>                               89060000
<<>>                       parm1,                                       89065000
<<>>                       parm2,                                       89070000
<<>>                       flags,                                       89075000
<<>>                       user'data'with'mask,                         89080000
<<>>                       true,                                        89085000
<<>>                       translate                    );              89090000
<<>>                                                                    89095000
<<>>  end;                                                              89100000
<<>>                                                                    89105000
<< --------------------------------------------------------- >>         89110000
                                                                        89115000
                                                                        89120000
                                                                        89125000
                                                                        89130000
<< ----- define physical page length -- function = 133 -[12] >>         89135000
<<>>                                                                    89140000
<<>>  begin                                                             89145000
<<>>                                                                    89150000
<<>>    return'information :=                                           89155000
<<>>        b08'write'data(cb'info,                                     89160000
<<>>                       dst'num,                                     89165000
<<>>                       address,                                     89170000
<<>>                       function,                                    89175000
<<>>                       0, << count >>                               89180000
<<>>                       parm1,                                       89185000
<<>>                       parm2,                                       89190000
<<>>                       flags,                                       89195000
<<>>                       user'data'with'mask,                         89200000
<<>>                       true,                                        89205000
<<>>                       translate                    );              89210000
<<>>                                                                    89215000
<<>>  end;                                                              89220000
<<>>                                                                    89225000
<< --------------------------------------------------------- >>         89230000
                                                                        89235000
                                                                        89240000
                                                                        89245000
                                                                        89250000
<< ----- page control -- function = 140 ----------------[13] >>         89255000
<<>>                                                                    89260000
<<>>  begin                                                             89265000
<<>>                                                                    89270000
<<>>    return'information :=                                           89275000
<<>>        b08'write'data(cb'info,                                     89280000
<<>>                       dst'num,                                     89285000
<<>>                       address,                                     89290000
<<>>                       function,                                    89295000
<<>>                       0, << count >>                               89300000
<<>>                       parm1,                                       89305000
<<>>                       parm2,                                       89310000
<<>>                       flags,                                       89315000
<<>>                       user'data'with'mask,                         89320000
<<>>                       true,                                        89325000
<<>>                       translate                    );              89330000
<<>>                                                                    89335000
<<>>  end;                                                              89340000
<<>>                                                                    89345000
<< --------------------------------------------------------- >>         89350000
                                                                        89355000
                                                                        89360000
                                                                        89365000
                                                                        89370000
<< ----- clear environment -- function = 141 -----------[14] >>         89375000
<<>>                                                                    89380000
<<>>  begin                                                             89385000
<<>>                                                                    89390000
<<>>    return'information :=                                           89395000
<<>>        b08'write'data(cb'info,                                     89400000
<<>>                       dst'num,                                     89405000
<<>>                       address,                                     89410000
<<>>                       function,                                    89415000
<<>>                       0, << count >>                               89420000
<<>>                       parm1,                                       89425000
<<>>                       parm2,                                       89430000
<<>>                       flags,                                       89435000
<<>>                       user'data'with'mask,                         89440000
<<>>                       true,                                        89445000
<<>>                       translate                    );              89450000
<<>>                                                                    89455000
<<>>  end;                                                              89460000
<<>>                                                                    89465000
<< --------------------------------------------------------- >>         89470000
                                                                        89475000
                                                                        89480000
                                                                        89485000
                                                                        89490000
<< ----- start job -- function = 142 -------------------[15] >>         89495000
<<>>                                                                    89500000
<<>>  begin                                                             89505000
<<>>    return'information := b08'start'job(cb'info, parm1);            89510000
<<>>                                                                    89515000
<<>>    transfer'log := 0;                                              89520000
<<>>  end;                                                              89525000
<<>>                                                                    89530000
<< --------------------------------------------------------- >>         89535000
                                                                        89540000
                                                                        89545000
                                                                        89550000
                                                                        89555000
<< ----- load default environment -- function = 143 ----[16] >>         89560000
<<>>                                                                    89565000
<<>>  begin                                                             89570000
<<>>                                                                    89575000
<<>>    return'information :=                                           89580000
<<>>        b08'write'data(cb'info,                                     89585000
<<>>                       dst'num,                                     89590000
<<>>                       address,                                     89595000
<<>>                       function,                                    89600000
<<>>                       0, << count >>                               89605000
<<>>                       parm1,                                       89610000
<<>>                       parm2,                                       89615000
<<>>                       flags,                                       89620000
<<>>                       user'data'with'mask,                         89625000
<<>>                       true,                                        89630000
<<>>                       translate                    );              89635000
<<>>                                                                    89640000
<<>>  end;                                                              89645000
<<>>                                                                    89650000
<< --------------------------------------------------------- >>         89655000
                                                                        89660000
                                                                        89665000
                                                                        89670000
                                                                        89675000
<< ----- function = 144 (not supported) ----------------[17] >>         89680000
                                                                        89685000
      begin                                                             89690000
                                                                        89695000
$IF X9=ON  << ON = DEBUG MODE >>                                        89700000
                                                                        89705000
        << Download debug info to terminal softkeys >>                  89710000
        b08'debug'softkeys(cb'info);                                    89715000
                                                                        89720000
                                                                        89725000
$IF X9=OFF  << OFF = NO DEBUG >>                                        89730000
                                                                        89735000
        return'status := invalid'request;                               89740000
        transfer'log := 0;                                              89745000
                                                                        89750000
$IF                                                                     89755000
      end;                                                              89760000
<<>>                                                                    89765000
<< --------------------------------------------------------- >>         89770000
                                                                        89775000
                                                                        89780000
                                                                        89785000
                                                                        89790000
<< ----- end of job -- function = 145 ------------------[18] >>         89795000
<<>>                                                                    89800000
<<>>  begin                                                             89805000
<<>>                                                                    89810000
<<>>    return'information :=                                           89815000
<<>>        b08'end'job( cb'info,                                       89820000
<<>>                     dst'num,                                       89825000
<<>>                     address,                                       89830000
<<>>                     count,                                         89835000
<<>>                     flags     );                                   89840000
<<>>                                                                    89845000
<<>>  end;                                                              89850000
<<>>                                                                    89855000
<< --------------------------------------------------------- >>         89860000
                                                                        89865000
                                                                        89870000
                                                                        89875000
                                                                        89880000
<< ----- used for any in range of 128 - 192 that are  --[19] >>         89885000
<<       not implemented for this driver.  This allows       >>         89890000
<<       spool files created for a 2680A to be printed       >>         89895000
<<       on a 2608S if necessary.                            >>         89900000
<<>>                                                                    89905000
<<>>  begin                                                             89910000
<<>>                                                                    89915000
<<>>    return'status := successful;                                    89920000
<<>>    transfer'log := count;                                          89925000
<<>>                                                                    89930000
<<>>  end;                                                              89935000
<<>>                                                                    89940000
<< --------------------------------------------------------- >>         89945000
                                                                        89950000
                                                                        89955000
                                                                        89960000
                                                                        89965000
<< ----- device clear -- function = 189 ----------------[20] >>         89970000
<<>>                                                                    89975000
<<>>  begin                                                             89980000
<<>>    return'status := b08'device'clear(cb'info,parm1);               89985000
<<>>                                                                    89990000
<<>>    transfer'log := 0;                                              89995000
<<>>  end;                                                              90000000
<<>>                                                                    90005000
<< --------------------------------------------------------- >>         90010000
                                                                        90015000
                                                                        90020000
                                                                        90025000
                                                                        90030000
<< ----- begin silent run -- function = 190 ------------[21] >>         90035000
<<>>                                                                    90040000
<<>>  begin                                                             90045000
<<>>                                                                    90050000
<<>>    return'information :=                                           90055000
<<>>        b08'silent'run( cb'info,                                    90060000
<<>>                        dst'num,                                    90065000
<<>>                        address,                                    90070000
<<>>                        count,                                      90075000
<<>>                        flags     );                                90080000
<<>>                                                                    90085000
<<>>  end;                                                              90090000
<<>>                                                                    90095000
<< --------------------------------------------------------- >>         90100000
                                                                        90105000
                                                                        90110000
                                                                        90115000
                                                                        90120000
<< ----- get environment status -- function 191 --------[22] >>         90125000
<<>>                                                                    90130000
<<>>  begin                                                             90135000
<<>>                                                                    90140000
<<>>    return'information :=                                           90145000
<<>>      b08'buffered'env'status( cb'info,                             90150000
<<>>                               dst'num,                             90155000
<<>>                               address,                             90160000
<<>>                               count,                               90165000
<<>>                               buffered    );                       90170000
<<>>                                                                    90175000
<<>>  end;                                                              90180000
<<>>                                                                    90185000
<< --------------------------------------------------------- >>         90190000
                                                                        90195000
                                                                        90200000
                                                                        90205000
                                                                        90210000
<< ----- expanded features -- function = 146 -----------[23] >>         90215000
<<>>                                                                    90220000
<<>>  begin                                                             90225000
<<>>                                                                    90230000
<<>>    return'status :=                                                90235000
<<>>        b08'set'ext'mode( cb'info,                                  90240000
<<>>                          parm1     );                              90245000
<<>>                                                                    90250000
<<>>    transfer'log := 0;                                              90255000
<<>>                                                                    90260000
<<>>  end;                                                              90265000
<<>>                                                                    90270000
<< --------------------------------------------------------- >>         90275000
                                                                        90280000
                                                                        90285000
                                                                        90290000
                                                                        90295000
<< ----- start of block -- function = 147 --------------[24] >>         90300000
<<>>                                                                    90305000
<<>>  begin                                                             90310000
<<>>                                                                    90315000
<<>>    return'information :=                                           90320000
<<>>        b08'start'block( cb'info,                                   90325000
<<>>                         parm1,                                     90330000
<<>>                         parm2    );                                90335000
<<>>                                                                    90340000
<<>>    transfer'log := 0;                                              90345000
<<>>                                                                    90350000
<<>>  end;                                                              90355000
<<>>                                                                    90360000
<< --------------------------------------------------------- >>         90365000
                                                                        90370000
                                                                        90375000
                                                                        90380000
                                                                        90385000
<< ----- end of block -- function = 148 ----------------[25] >>         90390000
<<>>                                                                    90395000
<<>>  begin                                                             90400000
<<>>                                                                    90405000
<<>>    return'information :=                                           90410000
<<>>        b08'end'block( cb'info );                                   90415000
<<>>                                                                    90420000
<<>>  end;                                                              90425000
<<>>                                                                    90430000
<< --------------------------------------------------------- >>         90435000
                                                                        90440000
                                                                        90445000
                                                                        90450000
                                                                        90455000
<< ----- Return status types -- function = 187 ---------[26] >>         90460000
<<>>                                                                    90465000
<<>>  begin                                                             90470000
<<>>                                                                    90475000
<<>>    return'information :=                                           90480000
<<>>        b08'available'status( cb'info,                              90485000
<<>>                              dst'num,                              90490000
<<>>                              address,                              90495000
<<>>                              count    );                           90500000
<<>>                                                                    90505000
<<>>  end;                                                              90510000
<<>>                                                                    90515000
<< --------------------------------------------------------- >>         90520000
                                                                        90525000
                                                                        90530000
                                                                        90535000
                                                                        90540000
<< ----- Set status types -- function = 188 ------------[27] >>         90545000
<<>>                                                                    90550000
<<>>  begin                                                             90555000
<<>>                                                                    90560000
<<>>    return'information :=                                           90565000
<<>>        b08'set'status'types( cb'info,                              90570000
<<>>                              dst'num,                              90575000
<<>>                              address,                              90580000
<<>>                              count,                                90585000
<<>>                              parm1    );                           90590000
<<>>                                                                    90595000
<<>>  end;                                                              90600000
<<>>                                                                    90605000
<< --------------------------------------------------------- >>         90610000
                                                                        90615000
                                                                        90620000
                                                                        90625000
                                                                        90630000
<< ----- Control mask -- function = 185 ----------------[28] >>         90635000
<<>>                                                                    90640000
<<>>  begin                                                             90645000
<<>>                                                                    90650000
<<>>    return'information :=                                           90655000
<<>>        b08'control'mask( cb'info,                                  90660000
<<>>                          dst'num,                                  90665000
<<>>                          address,                                  90670000
<<>>                          count,                                    90675000
<<>>                          flags    );                               90680000
<<>>                                                                    90685000
<<>>  end;                                                              90690000
<<>>                                                                    90695000
<< --------------------------------------------------------- >>         90700000
                                                                        90705000
                                                                        90710000
                                                                        90715000
                                                                        90720000
<< ----- Job report immediate -- function = 186 --------[29] >><<04422>>90725000
<<>>                                                                    90730000
<<>>  begin                                                             90735000
<<>>                                                                    90740000
<<>>    return'information :=                                           90745000
<<>>        b08'return'job'report( cb'info,                             90750000
<<>>                               dst'num,                             90755000
<<>>                               address,                             90760000
<<>>                               count,                               90765000
<<>>                               immediate  );               <<04422>>90770000
<<>>                                                                    90775000
<<>>  end;                                                              90780000
<<>>                                                                    90785000
<< --------------------------------------------------------- >>         90790000
                                                                        90795000
                                                                        90800000
                                                                        90805000
                                                                        90810000
<< ----- Flush out buffers - function = 182 ------------[30] >>         90815000
<<>>                                                                    90820000
<<>>  begin                                                             90825000
<<>>                                                                    90830000
<<>>    return'status := b08'flush'out'buffers( cb'info );              90835000
<<>>    transfer'log := 0;                                              90840000
<<>>                                                                    90845000
<<>>  end;                                                              90850000
<<>>                                                                    90855000
<< --------------------------------------------------------- >>         90860000
                                                                        90865000
                                                                        90870000
                                                                        90875000
                                                                        90880000
<< ----- Erase buffers -- function = 182 ---------------[31] >>         90885000
<<>>                                                                    90890000
<<>>  begin                                                             90895000
<<>>                                                                    90900000
<<>>    return'status := b08'erase'buffers( cb'info );                  90905000
<<>>    transfer'log := 0;                                              90910000
<<>>                                                                    90915000
<<>>  end;                                                              90920000
<<>>                                                                    90925000
<< --------------------------------------------------------- >>         90930000
                                                                        90935000
                                                                        90940000
                                                                        90945000
                                                                        90950000
<< ----- set record length -- function = 255 -----------[32] >>         90955000
<<>>                                                                    90960000
<<>>  begin                                                             90965000
<<>>                                                                    90970000
$IF X9 = ON  << INCLUDE DEBUGGING CODE >>                               90975000
<<>>                                                                    90980000
<<>>    return'information :=                                           90985000
<<>>        b08'set'rec'length( cb'info, parm1 );                       90990000
<<>>                                                                    90995000
$IF X9 = OFF  << DON'T INCLUDE DEBUGGING CODE >>                        91000000
<<>>                                                                    91005000
<<>>    return'status := invalid'function;                              91010000
<<>>                                                                    91015000
$IF                                                                     91020000
<<>>                                                                    91025000
<<>>  end;                                                              91030000
<<>>                                                                    91035000
<< --------------------------------------------------------- >>         91040000
                                                                        91045000
                                                                        91050000
                                                                        91055000
                                                                        91060000
<< ----- test CIPER shutdown -- function = 254 ---------[33] >>         91065000
<<>>                                                                    91070000
<<>>  begin                                                             91075000
<<>>                                                                    91080000
$IF X9 = ON  << INCLUDE DEBUGGING CODE >>                               91085000
<<>>                                                                    91090000
<<>>    return'information :=                                           91095000
<<>>        cpr'test'shutdown( 1, parm1 );                              91100000
<<>>                                                                    91105000
$IF X9 = OFF   << DON'T INCLUDE DEBUGGING CODE >>                       91110000
<<>>                                                                    91115000
<<>>    return'status := invalid'function;                              91120000
<<>>                                                                    91125000
$IF                                                                     91130000
<<>>  end;                                                              91135000
<<>>                                                                    91140000
<< --------------------------------------------------------- >>         91145000
                                                                        91150000
                                                                        91155000
                                                                        91160000
                                                                        91165000
<< ----- environment status immediate -- function = 180 [34] >>         91170000
<<>>                                                                    91175000
<<>>  begin                                                             91180000
<<>>                                                                    91185000
<<>>    return'information :=                                           91190000
<<>>        b08'buffered'env'status( cb'info                            91195000
<<>>                                ,dst'num                            91200000
<<>>                                ,address                            91205000
<<>>                                ,count                              91210000
<<>>                                ,immediate  );                      91215000
<<>>                                                                    91220000
<<>>  end;                                                              91225000
<<>>                                                                    91230000
<< --------------------------------------------------------- >>         91235000
                                                                        91240000
                                                                        91245000
                                                                        91250000
                                                                        91255000
<< ----- device status composite -- function = 181 -----[35] >>         91260000
<<>>                                                                    91265000
<<>>  begin                                                             91270000
<<>>                                                                    91275000
<<>>    return'information :=                                           91280000
<<>>        b08'buf'device'status( cb'info                              91285000
<<>>                              ,dst'num                              91290000
<<>>                              ,address                              91295000
<<>>                              ,count                                91300000
<<>>                              ,composite  );                        91305000
<<>>                                                                    91310000
<<>>  end;                                                              91315000
<<>>                                                                    91320000
<< --------------------------------------------------------- >>         91325000
                                                               <<04422>>91330000
                                                               <<04422>>91335000
                                                               <<04422>>91340000
                                                               <<04422>>91345000
<< ----- job report buffered -- function = 179 ---------[36] >><<04422>>91350000
<<>>                                                           <<04422>>91355000
<<>>  begin                                                    <<04422>>91360000
<<>>                                                           <<04422>>91365000
<<>>    return'information :=                                  <<04422>>91370000
<<>>        b08'return'job'report( cb'info                     <<04422>>91375000
<<>>                              ,dst'num                     <<04422>>91380000
<<>>                              ,address                     <<04422>>91385000
<<>>                              ,count                       <<04422>>91390000
<<>>                              ,buffered  );                <<04422>>91395000
<<>>                                                           <<04422>>91400000
<<>>  end;                                                     <<04422>>91405000
<<>>                                                           <<04422>>91410000
<< --------------------------------------------------------- >><<04422>>91415000
                                                                        91420000
                                                                        91425000
                                                               <<07425>>91430000
                                                               <<07425>>91435000
<< ----- enable logging event -- function = 250 --------[37] >><<07425>>91440000
<<>>                                                           <<07425>>91445000
<<>>  begin                                                    <<07425>>91450000
<<>>                                                           <<07425>>91455000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>91460000
<<>>                                                           <<07425>>91465000
<<>>    if logical(flags.diagnostic'request) then              <<07425>>91470000
<<>>      begin                                                <<07425>>91475000
<<>>        return'information :=                              <<07425>>91480000
<<>>            b08'enable'logging( cb'info, parm1 );          <<07425>>91485000
<<>>      end                                                  <<07425>>91490000
<<>>    else                                                   <<07425>>91495000
<<>>      begin                                                <<07425>>91500000
<<>>        return'status := invalid'function;                 <<07425>>91505000
<<>>      end;                                                 <<07425>>91510000
<<>>                                                           <<07425>>91515000
$IF X7 = OFF  << OFF = NO LOGGING >>                           <<07425>>91520000
<<>>                                                           <<07425>>91525000
<<>>    return'status := invalid'function;                     <<07425>>91530000
<<>>                                                           <<07425>>91535000
$IF                                                            <<07425>>91540000
<<>>                                                           <<07425>>91545000
<<>>  end;                                                     <<07425>>91550000
<<>>                                                           <<07425>>91555000
<< --------------------------------------------------------- >><<07425>>91560000
                                                               <<07425>>91565000
                                                               <<07425>>91570000
                                                               <<07425>>91575000
                                                               <<07425>>91580000
<< ----- disable logging event -- function = 251 -------[38] >><<07425>>91585000
<<>>                                                           <<07425>>91590000
<<>>  begin                                                    <<07425>>91595000
<<>>                                                           <<07425>>91600000
$IF X7 = ON  << ON = ENABLE LOGGING CODE >>                    <<07425>>91605000
<<>>                                                           <<07425>>91610000
<<>>    if logical(flags.diagnostic'request) then              <<07425>>91615000
<<>>      begin                                                <<07425>>91620000
<<>>        return'information :=                              <<07425>>91625000
<<>>            b08'disable'logging( cb'info, parm1 );         <<07425>>91630000
<<>>      end                                                  <<07425>>91635000
<<>>    else                                                   <<07425>>91640000
<<>>      begin                                                <<07425>>91645000
<<>>        return'status := invalid'function;                 <<07425>>91650000
<<>>      end;                                                 <<07425>>91655000
<<>>                                                           <<07425>>91660000
$IF X7 = OFF  << OFF = NO LOGGING >>                           <<07425>>91665000
<<>>                                                           <<07425>>91670000
<<>>    return'status := invalid'function;                     <<07425>>91675000
<<>>                                                           <<07425>>91680000
$IF                                                            <<07425>>91685000
<<>>  end;                                                     <<07425>>91690000
<<>>                                                           <<07425>>91695000
<< --------------------------------------------------------- >><<07425>>91700000
                                                               <<07425>>91705000
                                                               <<07425>>91710000
                                                                        91715000
                                                                        91720000
    end;  << of case compressed'function >>                             91725000
                                                                        91730000
                                                                        91735000
  exit'label:                                                           91740000
                                                                        91745000
  << Set up the function return value >>                                91750000
  set'status'for'return;                                                91755000
                                                               <<04422>>91760000
  resetcritical( saved'critical'value );                       <<04422>>91765000
                                                                        91770000
end;  << B08'LOGICAL'DVR >>                                             91775000
                                                                        91780000
$PAGE "GLOBAL SYMBOL TABLE"                                             91785000
$PAGE                                                                   91790000
$CONTROL SEGMENT= MAIN                                                  91795000
END.  << of module Softio (61) >>                                       91800000
