<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
$CONTROL USLINIT,CODE,MAP                                      <<03034>>00010000
<< BIPC - MODULE 65 >>                                                  00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL MAIN=BASIC'IPC,SEGMENT=BIPC,CODE,MAP                           00028000
$SET X0=OFF                                                             00030000
$PAGE "COMMUNICATIONS FILE PROCESS AWAKEN MECHANISM"                    00032000
Begin                                                                   00034000
equate                                                                  00036000
  version                         = 02,  <<12/06/80>>                   00038000
  update                          = 03;  <<06/03/81>>          <<03034>>00040000
                                                                        00042000
                                                                        00044000
<<Compile option                                                        00046000
                                                                        00048000
  X0  - on,  Call DEBUG before calling SUDDENDEATH                      00050000
      - off, Call SUDDENDEATH directly>>                                00052000
                                                                        00054000
                                                                        00056000
<<                                                                      00058000
Communications-File Basic IPC Mechanism                                 00060000
---------------------------------------                                 00062000
                                                                        00064000
                                                                        00066000
The objective of this set of uncallable intrinsics is to provide        00068000
a simple mechanism that will enable one process to send short           00070000
messages to another process.                                            00072000
                                                                        00074000
The heart of this mechanism is the port.  A process desiring to         00076000
receive messages would first open (create) a port.  This process        00078000
is termed the "port manager."  When the port is created, a port         00080000
number is returned to the opener.  There is no provision to             00082000
rendezvous with known "logical" port names so potential senders         00084000
need some method of obtaining the port number from the port             00086000
manager.                                                                00088000
                                                                        00090000
Both the ports and the messages are contained in a disc resident        00092000
data segment.  There can be a total of over thiry-five hundred          00094000
open ports and outstanding messages  Thus neither ports nor             00096000
message blocks are scarce resources.                                    00098000
                                                                        00100000
                                                                        00102000
A return port is explicitly passed in FCPORTSEND so that messages       00104000
that timeout can be given back to a port belonging to the               00106000
originator.                                                             00108000
                                                                        00110000
A process desiring some service from another process would use          00112000
this mechanism in the following manner.                                 00114000
                                                                        00116000
  1. An FCPORTSEND, specifying a return port, is issued to the          00118000
     proper port.  The message's parameters specify the service         00120000
     to be performed.  This results in an MQE's (message queue          00122000
     entry) being obtained, initialized, and queued to the tail         00124000
     of the port.                                                       00126000
                                                                        00128000
  2. At some later point in time the process decides to                 00130000
     synchronize with the request by issuing an FCPORTRECEIVE           00132000
     with wait against its own return port.                             00134000
                                                                        00136000
  3. The port's manager process steps through the messages on           00138000
     the port, eventually processing the MQE used in steps 1 and        00140000
     2.  This process awakens the first process by sending a            00142000
     return message to the original process's return port.              00144000
                                                                        00146000
     Note that steps 2 and 3 could have occurred in reverse             00148000
     order.                                                             00150000
                                                                        00152000
  4. When the first process runs, it is still in FCPORTRECEIVE          00154000
     which places the second MQE on the free list and returns to        00156000
     the process's calling procedure.                                   00158000
                                                                        00160000
Notes:                                                                  00162000
                                                                        00164000
  1) This set of procedures is very closely keyed to the needs          00166000
     of the MSG file access method.  Any other use of this code         00168000
     is prohibited since these procedures may be obsoleted by           00170000
     future MPE message facilities.                                     00172000
                                                                        00174000
  2) Unless otherwise noted, these procedures require DB to be at       00176000
     the stack.                                                         00178000
                                                                        00180000
  3) Software interrupts are enabled by the port's owner issuing        00182000
     an FCPORTCONTROL.  Sends to the port will then cause the           00184000
     user's interrupt procedure to be invoked with the following        00186000
     parameters:                                                        00188000
                                                                        00190000
       Q-6  Port number                                                 00194000
       Q-5  First port parameter (8:8)  (See FCPORTCONTROL)             00196000
       Q-4  Second port parameter                                       00198000
>>                                                                      00200000
$PAGE "DATA STRUCTURES."                                                00202000
<<* * * Port Data Structures * * *>>                                    00204000
                                                                        00206000
                                                                        00208000
                                                                        00210000
<<* * * Global Area * * *                                               00212000
                                                                        00214000
    ....................................................                00216000
  0 :  Data segment number of this port data segment   : 0              00218000
    ....................................................                00220000
  1 :  Block size in words                             : 1              00222000
    ....................................................                00224000
  2 :  Total number of blocks                          : 2              00226000
    ....................................................                00230000
  3 :  Maximum number of blocks                        : 3              00232000
    ....................................................                00234000
  4 :  Current number of free blocks                   : 4              00236000
    ....................................................                00238000
  5 :  Number of open ports                            : 5              00240000
    ....................................................                00242000
  6 :  Head of free list                               : 6              00244000
    ....................................................                00246000
  7 :  Tail of free list                               : 7              00248000
    ....................................................                00250000
 10 :  Head of impeded process list                    : 8              00252000
    ....................................................                00254000
 11 :  Tail of impeded process list                    : 9              00256000
    ....................................................                00258000
 12 :  Head of timeout thread (TQE address)            : 10             00260000
    ....................................................                00262000
 13 :  TRLX of timeout                                 : 11             00264000
    ....................................................                00266000
 14 :  Value returned by TIMER intrinsic when          : 12             00268000
    ...................            .....................                00270000
 15 :  Timeout was initiated.                          : 13             00272000
    ....................................................                00274000
 16 :  Head of port address list.                      : 14             00276000
    ....................................................                00278000
 17 :  Not used.                                       : 15             00280000
    ....................................................                00282000
>>                                                                      00284000
                                                                        00286000
integer                                                                 00288000
  GDST                            = DB+0,                               00290000
  Gblock'size                     = DB+1,                               00292000
  Gtotal'blocks                   = DB+2,                               00294000
  Gmax'blocks                     = DB+3,                               00296000
  Gnum'free'blocks                = DB+4,                               00298000
  Gnum'open'ports                 = DB+5,                               00300000
  Gfree'head                      = DB+6,                               00302000
  Gfree'tail                      = DB+7,                               00304000
  Gimpede'head                    = DB+8,                               00306000
  Gimpede'tail                    = DB+9,                               00308000
  GheadTLE                        = DB+10,                              00310000
  GTRLX                           = DB+11;                              00312000
double                                                                  00314000
  Gstart'time                     = DB+12;                              00316000
integer                                                                 00318000
  Gport'head                      = DB+14;                              00320000
                                                                        00322000
equate                                                                  00324000
  global'size                     = 16,                                 00326000
  block'size                      = 8,                                  00328000
  init'blocks                     = 50,                                 00330000
  max'blocks                      = %7000,                              00332000
  expand'blocks                   = 50,                                 00334000
  initial'size                    = global'size+block'size*init'blocks, 00336000
  max'size                        = global'size+block'size*max'blocks;  00338000
                                                                        00340000
                                                                        00342000
                                                                        00344000
<<* * * Port * * *                                                      00346000
                                                                        00348000
     0  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16                 00350000
    ...:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:...                00352000
  0 :  Head MQE address                                : 0              00354000
    ....................................................                00356000
  1 :  Tail MQE address                                : 1              00358000
    ....................................................                00360000
  2 :E :W type: Port list thread.                      : 2              00362000
    ....................................................                00364000
  3 :  Soft int subtype    :  Pin of the port manager  : 3              00366000
    ....................................................                00368000
  4 :  Soft interrupt parameter one                    : 4              00370000
    ....................................................                00372000
  5 :  Number of MQEs in the port's queue              : 5              00374000
    ....................................................                00376000
  6 :  Number of sends to this port                    : 6              00378000
    ....................................................                00380000
  7 :  Soft interrupt plabel                           : 7              00382000
    ....................................................                00384000
    :0 :1 :2 :3 :4 :5 :6 :7 :8 :9 :10:11:12:13:14:15:16:                00386000
                                                                        00388000
    E       Enable wake up bit                                          00390000
            0 - Do not awaken the process                               00392000
            1 - Awaken the process                                      00394000
                                                                        00396000
    W type  Action to be taken on an enabled empty port when            00400000
            a message is received.                                      00402000
                                                                        00404000
            Value  Action                                               00406000
            -----  ---------------------------------------              00408000
            0      Awaken on port                                       00410000
            1      User software interrupt                              00412000
            2      System soft interrupt                                00414000
            3      Reserved                                             00416000
>>                                                                      00418000
                                                                        00420000
define                                                                  00422000
  PheadMQE                        = port                #,              00424000
  PtailMQE                        = port(1)             #,              00426000
  Pmisc                           = port(2)             #,              00428000
  Penable                         = port(2).(0:1)       #,              00430000
  Pwake'type                      = port(2).(1:2)       #,              00434000
  Pport'thread                    = port(2).(3:13)      #,              00436000
  thread'loc                      = 2                   #,              00438000
  port'thread                     = (3:13)              #,              00440000
  Psoft'subtype                   = port(3).(0:8)       #,              00442000
  Pport'pin                       = port(3).(8:8)       #,              00444000
  Psoft'parameter                 = port(4)             #,              00446000
  PpendingMQE                     = port(5)             #,              00448000
  Pnum'sends                      = port(6)             #,              00450000
  Psoft'int'plabel                = port(7)             #;              00452000
                                                                        00454000
equate                                                                  00456000
  port'size                       = 8,                                  00458000
  user'type                       = 1;                                  00460000
                                                                        00462000
                                                                        00464000
                                                                        00466000
<<* * * Message Queue Entry (MQE) * * *                                 00468000
                                                                        00470000
     0  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16                 00472000
    ...:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:...                00474000
  0 :  Next MQE entry; if last, (port addr) LOR 7      : 0              00476000
    ....................................................                00478000
  1 :  Return port                                     : 1              00480000
    ....................................................                00482000
  2 :  Time List Entry (TLE), 0=no timeout,-1=timed out: 2              00484000
    ....................................................                00486000
  3 :  Parameter zero                                  : 3              00488000
    ....................................................                00490000
  4 :  Parameter one                                   : 4              00492000
    ....................................................                00494000
  5 :  Parameter two                                   : 5              00496000
    ....................................................                00498000
  6 :  Parameter three                                 : 6              00500000
    ....................................................                00502000
  7 :  Parameter four                                  : 7              00504000
    ....................................................                00506000
    :0 :1 :2 :3 :4 :5 :6 :7 :8 :9 :10:11:12:13:14:15:16:                00508000
                                                                        00510000
    Timer entry definitions - 0 - no timeout                            00512000
                              1 - timeout expired                       00514000
                              2 - TLE address for a pending timeout     00516000
>>                                                                      00518000
                                                                        00520000
define                                                                  00522000
  MnextMQE                        = MQE                 #,              00524000
  Mreturn'port                    = MQE(1)              #,              00526000
  MTLEaddress                     = MQE(2)              #,              00528000
  Mparameter0                     = MQE(3)              #,              00530000
  Mmsg'length                     = Gblock'size-3       #,              00532000
  MQEstopper                      = @port+7             #;              00534000
                                                                        00536000
define                                                                  00538000
  next'time                       = entrie(Mtime'loc)#,                 00540000
  next'entry                      = entrie(Mthread'loc)#,               00542000
  stopper'field                   = (13:3)#;                            00544000
equate                                                                  00546000
  stopper                         = 7,                                  00548000
  stopper'mask                    = %177770;                            00550000
                                                                        00552000
                                                                        00554000
                                                                        00556000
<<* * * Port DST Number Array * * *                                     00558000
                                                                        00560000
  Located in System DB Extension Area.                                  00562000
                                                                        00564000
    ....................................................                00566000
 64 : Port data segment number                         : 64             00568000
    ....................................................                00570000
 65 : Reserved for a second port segment               : 65             00572000
    ....................................................                00574000
>>                                                                      00576000
                                                                        00578000
equate                                                                  00580000
  extended'systemDB             = %1377;                                00582000
                                                                        00584000
define                                                                  00586000
  port'base'loc                 = abs(extended'systemDB)+%1100#,        00588000
  portDSTnumber                 = abs(port'base'loc+port'index)#,       00590000
  get'portDST                   = abs(port'base'loc+port'number)#;      00592000
                                                                        00594000
                                                                        00596000
                                                                        00598000
<<* * * Port number * * *                                               00600000
                                                                        00602000
     0  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16                 00604000
    ...:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:...                00606000
    :Port index :  Port data segment relative addr/8   :                00608000
    ....................................................                00610000
                                                                        00612000
    Port index   Index into the port DST number array                   00614000
>>                                                                      00616000
                                                                        00618000
define                                                                  00620000
  port'index                      = port'number.(0:4)        #,         00622000
  port'addr'field                 = port'number.(4:12)       #,         00624000
  port'address                    = port'number.(4:12)&lsl(3)#;         00626000
equate                                                                  00628000
  port'hash                       = 3,                                  00630000
  max'port'index                  = 1;                                  00632000
define                                                                  00634000
  port'num                        = @port.(3:10)             #;         00636000
                                                                        00638000
                                                                        00640000
                                                                        00642000
<<* * * Timer List Entry (TLE) * * *                                    00644000
                                                                        00646000
     0  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16                 00648000
    ...:..:..:..:..:..:..:..:..:..:..:..:..:..:..:..:...                00650000
  0 :  Next TLE (sorted in incr timeout val), 0 if last: 0              00652000
    ....................................................                00654000
  1 :  Preceding TLE entry (0 if this is the 1st entry): 1              00656000
    ....................................................                00658000
  2 :  Number of milliseconds the timeout value        : 2              00660000
    ...................              ...................                00662000
  3 :  of this TLE is beyond the previous TLE.         : 3              00664000
    ....................................................                00666000
  4 :  Address of the affected MQE                     : 4              00668000
    ....................................................                00670000
  5 :  Address of the MQE's port                       : 5              00672000
    ....................................................                00674000
  6 :  Value of TIMER when this timeout expires        : 5       HM.XX  00676000
    ..............                        ..............         HM.XX  00678000
  7 :  (Milliseconds)                                  : 7       HM.XX  00680000
    ....................................................                00682000
    :0 :1 :2 :3 :4 :5 :6 :7 :8 :9 :10:11:12:13:14:15:16:                00684000
                                                                        00686000
>>                                                                      00688000
                                                                        00690000
define                                                                  00692000
  TnextTLE                        = TLE                 #,              00694000
  TlastTLE                        = TLE(1)              #,              00696000
  Ttime'increment                 = TLED(1)             #,              00698000
  TMQEaddress                     = TLE(4)              #,              00700000
  Tport'address                   = TLE(5)              #,              00702000
  Ttarget'time                    = TLED(3)             #,     <<03034>>00706000
                                                                        00708000
  LnextTLE                        = lastTLE             #,              00710000
  LlastTLE                        = lastTLE(1)          #,              00712000
  Ltime'increment                 = lastTLED(1)         #,              00714000
  LMQEaddress                     = lastTLE(4)          #,              00716000
  Lport'address                   = lastTLE(5)          #,              00718000
  Ltarget'time                    = lastTLED(3)         #,     <<03034>>00722000
                                                                        00724000
  NnextTLE                        = nextTLE             #,              00726000
  NlastTLE                        = nextTLE(1)          #,              00728000
  Ntime'increment                 = nextTLED(1)         #,              00730000
  NMQEaddress                     = nextTLE(4)          #,              00732000
  Nport'address                   = nextTLE(5)          #,              00734000
  Ntarget'time                    = nextTLED(3)         #;     <<03034>>00738000
                                                                        00740000
equate                                                                  00742000
  awaken'process                  = 0,                                  00744000
  soft'int'process                = 1,                                  00746000
  port'timeout                    = 8,                                  00748000
  timeout'occurred                = -1;                        <<03034>>00750000
                                                                        00754000
define                                                                  00756000
  T24day'value                    = 2073600000d         #;              00758000
                                                                        00760000
                                                                        00762000
                                                                        00764000
<<* * * General Procedure Data Structure * * *>>                        00766000
                                                                        00768000
define                                                                  00770000
  data'structure           = integer pointer MQE;                       00772000
                             integer pointer port;                      00774000
                             double caller'address;                     00776000
                             integer callerDST=caller'address;          00778000
                             integer caller'offset=caller'address+1#;   00780000
                                                                        00782000
                                                                        00784000
                                                                        00786000
<<* * * MMSTAT Definitions * * *                                        00788000
                                                                        00790000
  Octal  Event Type  Parameter 0    Parameter 1    Parameter 2          00792000
  Value                                                                 00794000
  -----  ----------  -------------  -------------  -------------        00796000
  62     Open        Port number    Port DST num   Flags parameter      00798000
  63     Receive     Port number    MQE address    Return port          00802000
         completion                 15:1 Waitspc                        00804000
  64     Send        Port number    MQE address    Return port          00806000
                                    15:1 Q type                         00808000
  65     Change      Port number    0 = enable     Head MQE             00810000
         status                     1 = disable    address              00812000
  66     Abort       Port number    Parameter      Return port          00814000
                                    zero                                00816000
  67     Close       Port number    Port DST       # open               00818000
                                                   ports left           00820000
  70     Expand      Port DST num   # expand blks  Total #              00822000
                                                   blocks               00824000
                                                                        00826000
  71     Timeout     Port num       MQE address    Return port          00828000
         expired                                                        00830000
>>                                                                      00832000
                                                                        00834000
equate                                                                  00836000
  MMopen                          = -50,                                00838000
  MMreceive'completion            = -51,                                00840000
  MMsend                          = -52,                                00842000
  MMchange'state                  = -53,                                00844000
  MMabort                         = -54,                                00846000
  MMclose                         = -55,                                00848000
  MMexpand'seg                    = -56,                                00850000
  MMtimeout'exp                   = -57,                                00852000
                                                                        00854000
  MMenable'port                   = 1,                                  00856000
  MMdisable'port                  = 0;                                  00858000
                                                                        00860000
define                                                                  00862000
  mmstat'enabled                  = absolute(%1267)#;          <<03034>>00864000
                                                                        00866000
                                                                        00868000
                                                                        00870000
<<* * * Low Fixed Memory * * *>>                                        00872000
                                                                        00874000
equate                                                                  00876000
  DSTB                            = 2,                                  00878000
  PCBB                            = 3,                                  00880000
  CPCB                            = 4;                                  00882000
                                                                        00884000
                                                                        00886000
<<* * * Process Control Block * * *>>                                   00888000
                                                                        00890000
integer pointer                                                         00892000
  DST=2,                                                                00894000
  PCB=3;                                                                00896000
equate                                                                  00898000
  impedeloc                       = 8,                                  00900000
  PCBlen                          = 16;                                 00902000
define                                                                  00904000
  get'pin                         =(abs(CPCB)-abs(PCBB))/PCBlen#,       00906000
  PCBstackDSTnum                  =abs(abs(CPCB)+3).(1:10)#,            00908000
  PCBimpede'field                 =abs(abs(CPCB)+8).(8:8)#,             00910000
  PCBXDBvalue                     =push(dl); tos:=tos-ps0(-1);          00912000
                                   tos:=ps0(1); delb#,                  00914000
  impedefield                     =(8:8)#;                              00916000
                                                                        00918000
                                                                        00920000
                                                                        00922000
<<* * * Miscellaneous * * *>>                                           00924000
                                                                        00926000
equate                                                                  00928000
  ugly'port'problem               = 690,    <<Sudden death #>> <<03034>>00930000
  user'interrupt                  = 0,                                  00932000
  system'interrupt                = 1,                                  00934000
  return'me                       = 0,      <<GETFREEBLOCK input>>      00936000
  impede'me                       = 1,                                  00938000
  expand'seg                      = 2,                                  00940000
  only'manager                    = true,   <<PREPPORT input>>          00942000
  any'accessor                    = false,                              00944000
  CCG                             = 0,                                  00946000
  CCL                             = 1,                                  00948000
  CCE                             = 2,                                  00950000
  no'impede                       = false,                              00952000
  queue'to'tail                   = 0,                                  00954000
  port'wake                       = %4;                                 00956000
                                                                        00958000
integer                                                                 00960000
  s0=s-0,s3=s-3,s4=s-4,status=Q-1,x=x;                                  00962000
integer pointer                                                         00964000
  ps0=s-0;                                                              00966000
Logical                                                                 00968000
  pmap=q-4;                                                             00970000
integer pointer                                                         00972000
  sp0=s-0;                                                              00974000
array                                                                   00976000
  db0(*)=db+0;                                                          00978000
define                                                                  00980000
  abs                             = absolute         #,                 00982000
  condition'code                  = status.(6:2)     #,                 00984000
  int                             = integer          #,                 00986000
  log                             = logical          #,                 00988000
  dbl                             = double           #,                 00990000
  asmb                            = assemble         #,                 00992000
  enable                          = asmb(sed 1)      #,                 00994000
  disable                         = asmb(sed 0)      #,                 00996000
  pseudoenable                    = assemble(pseb)   #,                 00998000
  pseudodisable                   = assemble(psdb)   #;                 01000000
$PAGE "EXTERNAL PROCEDURES."                                            01004000
intrinsic DEBUG,TIMER;                                                  01006000
                                                                        01008000
procedure CAUSESOFTINT(pcbptr,type,subtype,plabel,msglength,flags);     01010000
value pcbptr,type,subtype,plabel,msglength,flags;                       01012000
integer pcbptr,type,subtype,plabel,msglength;                           01014000
logical flags;                                                          01016000
option external;                                                        01018000
                                                                        01020000
procedure HELP;                                                         01022000
option external;                                                        01024000
                                                                        01026000
integer procedure EXCHANGEDB(DSTnumber);                                01028000
value DSTnumber;                                                        01030000
integer DSTnumber;                                                      01032000
option external;                                                        01034000
                                                                        01036000
integer procedure GETDATASEG(memsize,maxsize);                          01038000
value memsize,maxsize;                                                  01040000
logical memsize,maxsize;                                                01042000
option external;                                                        01044000
                                                                        01046000
integer procedure ALTDSEGSIZE(DSTnumber,change);                        01048000
value DSTnumber,change;                                                 01050000
integer DSTnumber,change;                                               01052000
option external;                                                        01054000
                                                                        01056000
procedure QUEUEONSEGMENT(seg'num);                             <<03034>>01060000
value seg'num;                                                 <<03034>>01062000
integer seg'num;                                               <<03034>>01064000
option external;                                               <<03034>>01066000
                                                                        01068000
procedure RELDATASEG(DSTnumber);                                        01070000
value DSTnumber;                                                        01072000
logical DSTnumber;                                                      01074000
option external;                                                        01076000
                                                                        01078000
procedure SUDDENDEATH(deathnumber);                                     01080000
value deathnumber;                                                      01082000
integer deathnumber;                                                    01084000
option external;                                                        01086000
                                                                        01088000
procedure IMPEDE(PCBpt);                                                01090000
value PCBpt;                                                            01092000
integer PCBpt;                                                          01094000
option external;                                                        01096000
                                                                        01098000
procedure UNIMPEDE(PCBpt);                                              01100000
value PCBpt;                                                            01102000
integer PCBpt;                                                          01104000
option external;                                                        01106000
                                                                        01110000
procedure WAIT(waitflag,subpri);                                        01112000
value waitflag,subpri;                                                  01114000
integer waitflag;                                                       01116000
logical subpri;                                                         01118000
option external;                                                        01120000
                                                                        01122000
procedure AWAKE(PCBpt,condition,waitflag);                              01124000
value PCBpt,condition,waitflag;                                         01126000
integer PCBpt,waitflag;                                                 01128000
logical condition;                                                      01130000
option external;                                                        01132000
                                                                        01134000
integer procedure TIMEREQ(code,req,time);                               01136000
value code,req,time;                                                    01138000
integer code,req;                                                       01140000
double time;                                                            01142000
option external;                                                        01144000
                                                                        01146000
procedure ABORTTIMEREQ(trlx);                                           01148000
value trlx;                                                             01150000
integer trlx;                                                           01152000
option external;                                                        01154000
                                                                        01156000
procedure MMSTAT(entrie,p0,p1,p2);                                      01158000
value entrie,p0,p1,p2;                                                  01160000
integer entrie,p0,p1,p2;                                                01162000
option external;                                                        01164000
$CONTROL LIST                                                           01166000
$PAGE "UTILITY PROCEDURES."                                             01168000
procedure HELPME;                                                       01170000
begin                                                                   01172000
HELP;                                                                   01174000
end;  <<HELPME>>                                                        01176000
procedure UGLYPORTACCESS;                                               01178000
                                                                        01180000
<<Function                                                              01182000
  Called when an irrecoverable access error is encountered.>>           01184000
                                                                        01186000
<<Input                                                                 01188000
  None.>>                                                               01190000
                                                                        01192000
<<Output                                                                01194000
  None.>>                                                               01196000
option privileged,internal;                                             01198000
                                                                        01200000
begin                                                                   01202000
$IF X0=ON                                                               01204000
DEBUG;                                                                  01206000
$IF                                                                     01208000
SUDDENDEATH(ugly'port'problem);                                         01210000
end;  <<UGLYPORTACCESS>>                                                01212000
procedure PUTFREEBLOCK(block);                                          01214000
value block;                                                            01216000
                                                                        01218000
<<Function                                                              01220000
  Returns an entry to the free list.>>                                  01222000
                                                                        01224000
<<Input>>                                                               01226000
  pointer                                                               01228000
    block;               <<Address of the entry to be returned.>>       01230000
                                                                        01232000
<<Output                                                                01234000
  None.>>                                                               01236000
                                                                        01238000
<<Algorithm                                                             01240000
  Place the entry back on the free list                                 01242000
  Increment the number of free blocks                                   01244000
  If a process is impeded on an available entry then                    01246000
    begin                                                               01248000
    Delete the process from impeded queue                               01250000
    Unimpede the process                                                01252000
    end                                                                 01254000
>>                                                                      01256000
option privileged,internal;                                             01258000
                                                                        01260000
begin                                                                   01262000
integer                                                                 01264000
  PCBpt;                                                                01266000
                                                                        01268000
<<Place the entry on the free list>>                                    01270000
block:=0;                                                               01272000
pseudodisable;                                                          01274000
if (tos:=Gfree'tail) = 0 then                                           01276000
  Gfree'head:=@block                                                    01278000
else                                                                    01280000
  sp0:=@block;                                                          01282000
Gfree'tail:=@block;                                                     01284000
                                                                        01286000
<<if a process is impeded on a free entry, then awaken it>>             01288000
if Gimpede'head <> 0 then                                               01290000
  begin                                                                 01292000
  PCBpt:=Gimpede'head*PCBlen;                                           01294000
  if (Gimpede'head:=PCB(PCBpt+impedeloc).impedefield) = 0 then          01296000
    Gimpede'tail:=0;                                                    01298000
  PCB(PCBpt+impedeloc).impedefield:=0;                                  01300000
  pseudoenable;                                                         01302000
  UNIMPEDE(PCBpt);                                                      01304000
  end                                                                   01306000
else                                                                    01308000
  begin                                                                 01310000
  Gnum'free'blocks:=Gnum'free'blocks+1;                                 01312000
  pseudoenable;                                                         01314000
  end;                                                                  01316000
end;  <<PUTFREEBLOCK>>                                                  01318000
procedure EXPANDPORTSEG(num'new'blocks);                                01320000
value num'new'blocks;                                                   01322000
                                                                        01324000
<<Function                                                              01326000
  Expands an extant port data segment.>>                                01328000
                                                                        01330000
<<Input>>                                                               01332000
  integer                                                               01334000
    num'new'blocks;     <<Number of entries to expand>>                 01336000
                                                                        01338000
<<Output                                                                01340000
  None.>>                                                               01342000
                                                                        01344000
option privileged,internal;                                             01346000
                                                                        01348000
begin                                                                   01350000
integer                                                                 01352000
  portDST,increment,i;                                                  01354000
pointer                                                                 01356000
  block;                                                                01358000
                                                                        01360000
<<Expand the port data segment>>                                        01362000
increment:=num'new'blocks*Gblock'size;                                  01364000
portDST:=EXCHANGEDB(0);                                                 01366000
ALTDSEGSIZE(portDST,increment);                                         01368000
if <> then UGLYPORTACCESS;                                              01370000
EXCHANGEDB(portDST);                                                    01372000
                                                                        01374000
<<Assimilate new area into the free list>>                              01376000
i:=num'new'blocks;                                                      01378000
@block:=Gtotal'blocks*Gblock'size+global'size;                          01380000
do                                                                      01382000
  begin                                                                 01384000
  block:=0; move block(1):=block,(Gblock'size-1);                       01386000
  PUTFREEBLOCK(block);                                                  01388000
  @block:=@block+Gblock'size;                                           01390000
  end until (i:=i-1) = 0;                                               01392000
Gtotal'blocks:=Gtotal'blocks+num'new'blocks;                            01394000
if mmstat'enabled then                                                  01396000
  MMSTAT(MMexpand'seg,portDST,num'new'blocks,Gtotal'blocks);            01398000
end;  <<EXPANDPORTSEG>>                                                 01400000
integer procedure GETFREEBLOCK(impede'flag);                            01402000
value impede'flag;                                                      01404000
                                                                        01406000
<<Function                                                              01408000
  Obtains an entry from the free list.>>                                01410000
                                                                        01412000
<<Input>>                                                               01414000
  integer                                                               01416000
    impede'flag;       <<Specifies what to do if the free list          01418000
                          is empty.                                     01420000
                          0 - return                                    01422000
                          1 - if possible, expand port DST to           01424000
                              accommodate the request, else             01426000
                              return,                                   01428000
                          2 - if possible, expand port DST to           01430000
                              accommodate the request, else impede      01432000
                              until an entry becomes available.>>       01434000
                                                                        01436000
<<Output                                                                01438000
    GETFREEBLOCK          Address of the obtained entry.  A             01440000
                          zero is returned if no entry is               01442000
                          obtained.>>                                   01444000
                                                                        01446000
<<Algorithm                                                             01448000
  if entry available then                                               01450000
    Get head entry off the queue                                        01452000
  else if caller can be impeded then                                    01454000
    begin                                                               01456000
    if (number entrys + increment) < max entrys then                    01458000
      begin  <expand the data segment>                                  01460000
      Expand the data segment                                           01462000
      Create new free area                                              01464000
      Get head entry off the queue                                      01466000
      end                                                               01468000
    else                                                                01470000
      begin                                                             01472000
      Add process to the port's impede list                             01474000
      Impede                                                            01476000
      Get head entry off the queue                                      01478000
      end                                                               01480000
    end                                                                 01482000
  else                                                                  01484000
    Return a zero                                                       01486000
>>                                                                      01488000
option privileged,internal;                                             01490000
                                                                        01492000
begin                                                                   01494000
integer                                                                 01496000
  pin;                                                                  01498000
logical                                                                 01500000
  exhaust'blocks;                                                       01502000
                                                                        01504000
subroutine GETHEADENTRY;                                                01506000
  begin                                                                 01508000
  if (GETFREEBLOCK:=tos:=Gfree'head) = 0 then UGLYPORTACCESS;           01510000
  if (Gfree'head:=sp0) = 0 then Gfree'tail:=0;                          01512000
  del;                                                                  01514000
  end;  <<GETHEADENTRY>>                                                01516000
                                                                        01518000
pseudodisable;                                                          01520000
if (Gnum'free'blocks:=Gnum'free'blocks-1) >= 0 then                     01522000
  begin                                                                 01524000
  GETHEADENTRY;                                                         01526000
  pseudoenable;                                                         01528000
  end                                                                   01530000
else if impede'flag <> return'me then                                   01532000
  begin  <<None available but caller will expand port segment>>         01534000
  exhaust'blocks:=                                                      01536000
    ((Gtotal'blocks+expand'blocks) > Gmax'blocks);                      01538000
  if exhaust'blocks and impede'flag = expand'seg then                   01540000
    begin                                                               01542000
    Gnum'free'blocks:=Gnum'free'blocks+1;                               01544000
    pseudoenable;                                                       01546000
    end                                                                 01548000
  else if (Gnum'free'blocks = -1) and not exhaust'blocks then           01550000
    begin  <<Expand the port data segment>>                             01552000
    pseudoenable;                                                       01554000
    EXPANDPORTSEG(expand'blocks);                                       01556000
    GETHEADENTRY;                                                       01558000
    end                                                                 01560000
  else                                                                  01562000
    begin  <<Cannot expand port segment, so wait in line>>              01564000
    pin:=get'pin;                                                       01566000
    if Gimpede'head <> 0 then                                           01568000
      PCB(Gimpede'tail*PCBlen+impedeloc).impedefield:=pin               01570000
    else                                                                01572000
      Gimpede'head:=pin;                                                01574000
    Gimpede'tail:=pin;                                                  01576000
    IMPEDE(0);                                                          01578000
    GETHEADENTRY;                                                       01580000
    end;                                                                01582000
  end                                                                   01584000
else                                                                    01586000
  Gnum'free'blocks:=Gnum'free'blocks+1;                                 01588000
end; <<GETFREEBLOCK>>                                                   01590000
integer procedure CREATEPORTSEG;                                        01592000
                                                                        01594000
<<Function                                                              01596000
  Creates and initializes a port data segment.>>                        01598000
                                                                        01600000
<<Input                                                                 01602000
  None.>>                                                               01604000
                                                                        01606000
<<Output                                                                01608000
  CREATEPORTSEG           <> -1, port data segment number               01610000
                          =  -1, unable to create the segment>>         01612000
                                                                        01614000
option privileged,internal;                                             01616000
                                                                        01618000
begin                                                                   01620000
integer                                                                 01622000
  blocks'left,oldDST,portDST=CREATEPORTSEG;                             01624000
pointer                                                                 01626000
  block;                                                                01628000
                                                                        01630000
portDST:=GETDATASEG(initial'size,max'size);                             01632000
if = then                                                               01634000
  begin  <<Segment was created, perform initial formatting>>            01636000
  oldDST:=EXCHANGEDB(portDST);                                          01638000
  db0:=0;  <<Zero the data segment>>                                    01640000
  move db0(1):=db0,(initial'size-1);                                    01642000
  GDST:=portDST;                                                        01644000
  Gblock'size:=block'size;                                              01646000
  Gtotal'blocks:=init'blocks;                                           01648000
  Gmax'blocks:=max'blocks;                                              01650000
  blocks'left:=init'blocks; @block:=global'size;                        01652000
  do                                                                    01654000
    begin                                                               01656000
    PUTFREEBLOCK(block);                                                01658000
    @block:=@block+Gblock'size;                                         01660000
    end until (blocks'left:=blocks'left-1) = 0;                         01662000
  EXCHANGEDB(oldDST);                                                   01664000
  end;                                                                  01666000
end;  <<CREATEPORTSEG>>                                                 01668000
integer                                                                 01670000
procedure PREPPORT(port'number,port'manager'only,target,DST,address);   01672000
value port'number,port'manager'only,target;                             01674000
                                                                        01676000
<<Function                                                              01678000
  Switches to the proper port data segment.>>                           01680000
                                                                        01682000
<<Input>>                                                               01684000
  logical                                                               01686000
    port'number,        <<Caller's port number>>                        01688000
    port'manager'only;  <<Specifies the type of accessor                01690000
                          true - accessor must be port manager          01692000
                          false- accessor may be any process or         01694000
                                 interrupt handler.>>                   01696000
  integer pointer                                                       01698000
    target;             <<Caller's DB rel target array>>                01700000
                                                                        01702000
<<Output                                                                01704000
    PREPPORT              Address of the port>>                         01706000
  integer                                                               01708000
    DST,                <<Caller's stack DST>>                          01710000
    address;            <<Data seg relative target address>>            01712000
                                                                        01714000
  <<DB                    Switched to the port data segment.>>          01716000
                                                                        01718000
option privileged,internal;                                             01720000
                                                                        01722000
begin                                                                   01724000
integer pointer                                                         01726000
  port;                                                                 01728000
integer                                                                 01730000
  port'loc=PREPPORT,portDST;                                            01732000
                                                                        01734000
if port'index > max'port'index then UGLYPORTACCESS;                     01736000
if (portDST:=portDSTnumber) = 0 then UGLYPORTACCESS;                    01738000
DST:=PCBstackDSTnum;                                                    01740000
PCBXDBvalue;                                                            01742000
address:=tos+@target;                                                   01744000
EXCHANGEDB(portDST);                                                    01746000
if portDST <> GDST then UGLYPORTACCESS;                                 01748000
@port:=port'loc:=port'address;                                          01750000
if port'manager'only and (Pport'pin<>0) and (get'pin<>Pport'pin) then   01754000
  UGLYPORTACCESS;                                                       01758000
end;  <<PREPPORT>>                                                      01760000
procedure QUICKPREPPORT(port'number,port);                              01762000
value port'number,port;                                                 01764000
                                                                        01766000
<<Function                                                              01768000
  Moves the port's contents into caller's array.>>                      01770000
                                                                        01772000
<<Input>>                                                               01774000
  integer                                                               01776000
    port'number;        <<Caller's port number>>                        01778000
                                                                        01780000
<<Output>>                                                              01782000
  integer pointer                                                       01784000
    port;               <<Caller's local port array>>                   01786000
                                                                        01788000
option privileged,internal;                                             01790000
                                                                        01792000
begin                                                                   01794000
integer                                                                 01796000
  portDST;                                                              01798000
                                                                        01800000
if port'index > max'port'index then UGLYPORTACCESS;                     01802000
if (portDST:=portDSTnumber) = 0 then UGLYPORTACCESS;                    01804000
                                                                        01806000
<<Bring the port segment into main memory>>                             01808000
x:=portDST*4;                                                           01810000
disable;                                                                01812000
while DST(x) < 0 do                                                     01814000
  begin  <<Port segment not present>>                                   01816000
  enable;                                                               01818000
  QUEUEONSEGMENT(portDST);                                     <<03034>>01820000
  disable;                                                              01822000
  end;                                                                  01824000
pseudodisable;                                                          01826000
enable;                                                                 01828000
                                                                        01830000
<<Get the port's contents>>                                             01832000
tos:=@port;                                                             01834000
tos:=portDST;                                                           01836000
tos:=port'address;                                                      01838000
tos:=port'size;                                                         01840000
asmb(mfds 4);                                                           01842000
if (Pport'pin <> 0) and (get'pin <> Pport'pin) then                     01846000
    UGLYPORTACCESS;                                                     01848000
end;  <<QUICKPREPPORT>>                                                 01850000
procedure QUICKUNPREPPORT(port'number,port);                            01852000
value port'number,port;                                                 01854000
                                                                        01856000
<<Function                                                              01858000
  Moves contents of caller's array into the port's array.>>             01860000
                                                                        01862000
<<Input>>                                                               01864000
  integer                                                               01866000
    port'number;        <<Caller's port number>>                        01868000
  integer pointer                                                       01870000
    port;               <<Caller's local port array>>                   01872000
                                                                        01874000
<<Output                                                                01876000
  None.>>                                                               01878000
                                                                        01880000
option privileged,internal;                                             01882000
                                                                        01884000
begin                                                                   01886000
tos:=portDSTnumber;                                                     01888000
tos:=port'address;                                                      01890000
tos:=@port;                                                             01892000
tos:=port'size;                                                         01894000
asmb(mtds 4);                                                           01896000
pseudoenable;                                                           01898000
end;  <<QUICKUNPREPPORT>>                                               01900000
integer procedure QUEUETOPORT(port,mqe,flags);                          01902000
value port,mqe,flags;                                                   01904000
                                                                        01906000
<<Function                                                              01908000
  Queues the message to the port, if appropriate awakens the            01910000
  port's manager process.>>                                             01912000
                                                                        01914000
<<Input>>                                                               01916000
  integer pointer                                                       01918000
    port,               <<Address of the port>>                         01920000
    MQE;                <<Address of the Message Queue Entry>>          01922000
  logical                                                               01924000
    flags;              <<(15:1) - Manner to queue to the port          01926000
                                   0 - queue to tail                    01928000
                                   1 - queue to head                    01930000
                          (14:1) - Action to take if port is enabled    01932000
                                   0 - wake the process                 01934000
                                   1 - do not awaken the process,       01936000
                                       return its pin number in         01938000
                                       QUEUETOPORT>>                    01940000
                                                                        01942000
                                                                        01944000
<<Output                                                                01946000
  QUEUETOPORT             See flags.(14:1) description.>>               01948000
                                                                        01950000
option privileged,internal;                                             01952000
                                                                        01954000
begin                                                                   01956000
equate                                                                  01958000
  waken'process                   = 0,                                  01960000
  dont'wake'process               = 1,                                  01962000
  remain'active                   = 0;                                  01964000
define                                                                  01966000
  queue'type                      = flags#,                             01968000
  wake'process                    = not (flags.(14:1))#;                01970000
integer                                                                 01972000
  PCBpointer;                                                           01974000
double pointer                                                          01976000
  portd=port;                                                           01978000
logical                                                                 01980000
  wake'port'manager:=false;                                             01982000
                                                                        01984000
subroutine MAKESOFTINT(int'type,flags);                                 01986000
value int'type,flags;                                                   01988000
                                                                        01990000
<<Function                                                              01992000
  Makes the actual call to CAUSESOFTINT.>>                              01994000
                                                                        01996000
<<Input>>                                                               01998000
  integer                                                               02000000
    int'type,           <<Type of soft interrupt>>                      02002000
    flags;              <<Flags word of CAUSESOFTINT>>                  02004000
                                                                        02006000
<<Output                                                                02008000
  None.>>                                                               02010000
                                                                        02012000
  begin                                                                 02014000
  tos:=port'num; tos:=Psoft'parameter;  <<Stack the message>>           02016000
  CAUSESOFTINT(Pport'pin,s4,Psoft'subtype,Psoft'int'plabel,2,s3);       02018000
  end;  <<MAKESOFTINT>>                                                 02020000
<<Queue to the port>>                                                   02022000
pseudodisable;                                                          02024000
if PheadMQE = 0 then                                                    02026000
  begin  <<Queue is empty>>                                             02028000
  if PpendingMQE <> 0 then UGLYPORTACCESS;                              02030000
  PheadMQE:=PtailMQE:=@MQE;                                             02032000
  MnextMQE:=MQEstopper;                                                 02034000
  Wake'port'manager:=Penable;                                           02036000
  end                                                                   02038000
else                                                                    02040000
  case queue'type of                                                    02042000
    begin                                                               02044000
    begin  <<* Queue to tail>>                                          02046000
    MnextMQE:=MQEstopper;                                               02048000
    tos:=PtailMQE;                                                      02050000
    sp0:=@MQE;                                                          02052000
    PtailMQE:=@MQE;                                                     02054000
    end;                                                                02056000
    begin  <<* Queue to head>>                                          02058000
    MnextMQE:=PheadMQE;                                                 02060000
    PheadMQE:=@MQE;                                                     02062000
    end;                                                                02064000
    end;  <<case>>                                                      02066000
PpendingMQE:=PpendingMQE+1;                                             02068000
Pnum'sends:=Pnum'sends+1;                                               02070000
pseudoenable;                                                           02072000
                                                                        02074000
<<If first message to an enabled port, then activate the port           02076000
  manager process.>>                                                    02078000
if wake'port'manager then                                               02080000
  begin                                                                 02082000
  PCBpointer:=PCBlen*Pport'pin;                                         02084000
  if = then UGLYPORTACCESS;                                             02086000
  Penable:=false;                                                       02088000
  if wake'process then                                                  02090000
    begin                                                               02092000
    case Pwake'type of                                                  02094000
      begin  <<Awaken the port manager as he wants it>>                 02096000
      AWAKE(PCBpointer,port'wake,remain'active);   <<0 - normal wake>>  02098000
      MAKESOFTINT(user'interrupt,awaken'process);  <<1 - user soft int>>02100000
      MAKESOFTINT(system'interrupt,awaken'process);<<2 - sys soft int>> 02102000
      end;  <<case>>                                                    02104000
    end                                                                 02106000
  else                                                                  02108000
    begin  <<Just return the pin number>>                               02110000
    case Pwake'type of                                                  02112000
      begin                                                             02114000
      QUEUETOPORT:=Pport'pin;                                           02116000
      begin   <<User software interrupt>>                               02118000
      MAKESOFTINT(user'interrupt,dont'wake'process);                    02120000
      QUEUETOPORT:=-Pport'pin;                                          02122000
      end;                                                              02124000
      begin   <<System software interrupt>>                             02126000
      MAKESOFTINT(system'interrupt,dont'wake'process);                  02128000
      QUEUETOPORT:=-Pport'pin;                                          02130000
      end;                                                              02132000
      end;                                                              02134000
    end;                                                                02136000
  end;                                                                  02138000
end;  <<QUEUETOPORT>>                                                   02140000
procedure CAUSEOWNSOFTINT(port);                                        02142000
value port;                                                             02144000
                                                                        02146000
<<Function                                                              02148000
  Inflicts a soft interrupt on the current process.>>                   02150000
                                                                        02152000
<<Input>>                                                               02154000
  integer pointer                                                       02156000
    port;               <<Address of the port.>>                        02158000
                                                                        02160000
<<Output                                                                02162000
  None.>>                                                               02164000
                                                                        02166000
option privileged,internal;                                             02168000
                                                                        02170000
begin                                                                   02172000
integer                                                                 02174000
  int'type;                                                             02176000
                                                                        02178000
int'type:=                                                              02180000
  if Pwake'type = user'type then user'interrupt else system'interrupt;  02182000
tos:=port'num; tos:=Psoft'parameter;  <<Stack the message>>             02184000
CAUSESOFTINT(0,int'type,Psoft'subtype,Psoft'int'plabel,2,0);            02186000
if <> then UGLYPORTACCESS;                                              02188000
end;  <<CAUSEOWNSOFTINT>>                                               02190000
$PAGE "TIMEOUT PROCEDURES."                                             02192000
procedure STARTIMEOUT(MQE,port,port'number,timeout);                    02194000
value MQE,port,port'number,timeout;                                     02196000
                                                                        02198000
<<Function                                                              02200000
  Starts a timeout against the MQE.>>                                   02202000
                                                                        02204000
<<Input>>                                                               02206000
  integer pointer                                                       02208000
    MQE,                <<Address of Message Queue Entry>>              02210000
    port;               <<Address of the MQE's port>>                   02212000
  integer                                                               02214000
    port'number,        <<Port data segment's port index>>              02216000
    timeout;            <<Duration of the timeout, in seconds>>         02218000
                                                                        02220000
<<Output                                                                02222000
  None.>>                                                               02224000
                                                                        02226000
option privileged,internal;                                             02228000
                                                                        02230000
begin                                                                   02232000
double                                                                  02234000
  time'increment,current'time,elapsed'time;                             02236000
integer pointer                                                         02238000
  TLE,nextTLE,lastTLE:=0;                                               02240000
double pointer                                                          02242000
  TLED=TLE,lastTLED=lastTLE,nextTLED=nextTLE;                           02244000
                                                                        02246000
subroutine WEAVENTRY;                                                   02248000
  begin  <<Insert the TLE into the timer list>>                         02250000
  Ttime'increment:=time'increment;                                      02252000
  if (TnextTLE:=@nextTLE) <> 0 then                                     02254000
    begin  <<Next entry exists>>                                        02256000
    NlastTLE:=@TLE;                                                     02260000
    Ntime'increment:=Ntime'increment-time'increment;                    02262000
    end;                                                                02264000
  if (TlastTLE:=@lastTLE) <> 0 then LnextTLE:=@TLE;                     02266000
  end;  <<WEAVENTRY>>                                                   02268000
                                                                        02270000
                                                                        02272000
subroutine ISSUETIMEREQ;                                                02274000
  begin                                                                 02276000
  Gtrlx:=TIMEREQ(port'timeout,1,time'increment);                        02278000
  WEAVENTRY;                                                            02280000
  GheadTLE:=@TLE;                                                       02282000
  end;  <<ISSUETIMEREQ>>                                                02284000
                                                                        02286000
                                                                        02288000
<<Obtain and partially initialize a Timer List Entry>>                  02290000
MTLEaddress:=@TLE:=GETFREEBLOCK(impede'me);                             02292000
TMQEaddress:=@MQE; Tport'address:=@port;                       <<03034>>02294000
tos:=timeout; tos:=1000; asmb(lmpy); time'increment:=tos;               02296000
                                                                        02298000
<<Update the start time>>                                               02300000
pseudodisable;                                                          02302000
current'time:=TIMER;                                                    02304000
Ttarget'time:=current'time+time'increment;                     <<03034>>02306000
if Ttarget'time > T24day'value then                            <<03034>>02308000
  Ttarget'time:=Ttarget'time-T24day'value;                     <<03034>>02310000
if (elapsed'time:=current'time-Gstart'time) < 0d then                   02312000
  elapsed'time:=elapsed'time+T24day'value;                              02314000
Gstart'time:=current'time;                                              02316000
                                                                        02318000
<<Insert the TLE into the timer list>>                                  02320000
if (@nextTLE:=GheadTLE) = 0 then  <<Timer list empty?>>                 02322000
  ISSUETIMEREQ                                                          02324000
else                                                                    02326000
  begin  <<Not empty, find proper place in the list>>                   02328000
  Ntime'increment:=Ntime'increment-elapsed'time;                        02330000
  if Ntime'increment > time'increment then                              02332000
    begin  <<New timeout should be inserted at head of the list>>       02334000
    ABORTTIMEREQ(Gtrlx);                                                02336000
    ISSUETIMEREQ;                                                       02338000
    end                                                                 02340000
  else                                                                  02342000
    begin  <<New timeout belongs somewhere in the bowels of the list>>  02344000
    do                                                                  02346000
      begin  <<Scan list for proper slot>>                              02348000
      time'increment:=time'increment-Ntime'increment;                   02352000
      @lastTLE:=@nextTLE;                                               02354000
      end until (@nextTLE:=NnextTLE) = 0                                02356000
                or time'increment < Ntime'increment;                    02358000
    WEAVENTRY;                                                          02360000
    end;                                                                02362000
  end;                                                                  02364000
pseudoenable;                                                           02366000
end;  <<STARTIMEOUT>>                                                   02368000
procedure ABORTIMER(MQE);                                               02370000
value MQE;                                                              02372000
                                                                        02374000
<<Function                                                              02376000
  Aborts the pending timeout against the specified MQE.>>               02378000
                                                                        02380000
<<Input>>                                                               02382000
  integer pointer                                                       02384000
    MQE;                <<Address of the Message Queue Entry>>          02386000
                                                                        02388000
<<Output                                                                02390000
  None.>>                                                               02392000
                                                                        02394000
option privileged,internal;                                             02396000
                                                                        02398000
begin                                                                   02400000
integer pointer                                                         02402000
  TLE,lastTLE,nextTLE;                                                  02404000
double pointer                                                          02406000
  TLED=TLE,lastTLED=lastTLE,nextTLED=nextTLE;                           02408000
double                                                                  02410000
  old'time,elapsed'time;                                                02412000
                                                                        02414000
subroutine FIXNEXTLE;                                                   02416000
  begin                                                                 02418000
  Ntime'increment:=Ntime'increment+Ttime'increment;                     02422000
  NlastTLE:=@lastTLE;                                                   02424000
  end;  <<FIXNEXTLE>>                                                   02426000
                                                                        02428000
subroutine RESTARTIMER;                                                 02430000
  begin                                                                 02432000
  old'time:=Gstart'time;                                                02434000
  Gstart'time:=TIMER;                                                   02436000
  if (elapsed'time:=Gstart'time-old'time) < 0d then                     02438000
    elapsed'time:=elapsed'time+T24day'value;                            02440000
  Ttime'increment:=Ttime'increment-elapsed'time;                        02442000
  Gtrlx:=TIMEREQ(port'timeout,1,Ttime'increment);                       02444000
  end;  <<RESTARTIMER>>                                                 02446000
                                                                        02448000
                                                                        02450000
if (@TLE:=MTLEaddress) > 0 then                                         02452000
  begin  <<A timeout exists against the MQE>>                           02454000
  pseudodisable;                                                        02458000
  @nextTLE:=TnextTLE; @lastTLE:=TlastTLE;                               02460000
                                                                        02462000
  <<Delete the TLE from the timer list>>                                02464000
  if @lastTLE = 0 then                                                  02466000
    begin  <<The TLE is the first in the list>>                         02468000
    ABORTTIMEREQ(Gtrlx);                                                02470000
    Gtrlx:=0;                                                           02472000
    if (GheadTLE:=@nextTLE) <> 0 then                                   02474000
      begin  <<List is not empty>>                                      02476000
      FIXNEXTLE;                                                        02478000
      RESTARTIMER;                                                      02480000
      end;                                                              02482000
    end                                                                 02484000
  else                                                                  02486000
    begin  <<TLE is somewhere beyond the first entry>>                  02488000
    if (LnextTLE:=@nextTLE) <> 0 then FIXNEXTLE;                        02490000
    end;                                                                02492000
                                                                        02494000
  <<Return the TLE to the free list>>                                   02496000
  pseudoenable;                                                         02498000
  MTLEaddress:=0;                                                       02500000
  PUTFREEBLOCK(TLE);                                                    02504000
  end;                                                                  02506000
end;  <<ABORTIMER>>                                                     02508000
procedure FCPOSTIMEOUT(port'mask);                                      02510000
value port'mask;                                                        02512000
                                                                        02514000
<<Function                                                              02516000
  Posts timeout occurred on all MQEs which have timed out.>>            02518000
                                                                        02520000
<<Input                                                                 02522000
    DB                    May be set to any data segment, will be       02524000
                          unchanged on exit.>>                          02526000
  logical                                                               02528000
    port'mask;          <<Bit mask of port data segments which have     02530000
                          timed out.  The mask is in the right          02532000
                          byte with the following convention.           02534000
                          Bit num    Port segment index                 02536000
                          -------    ------------------                 02538000
                          15         0                                  02540000
                          14         1                                  02542000
                          ...                                           02544000
                          0          7>>                                02546000
                                                                        02548000
<<Output                                                                02550000
  None.>>                                                               02552000
                                                                        02554000
option privileged,uncallable;                                           02556000
                                                                        02558000
begin                                                                   02560000
integer                                                                 02562000
  port'number:=0,portDST,oldDST;                                        02564000
double                                                                  02566000
  current'time,elapsed'time;                                            02568000
integer pointer                                                         02570000
  TLE,MQE,port,return'port;                                             02572000
double pointer                                                          02574000
  TLED=TLE;                                                             02576000
define                                                                  02578000
  slop        = 50d#;   <<Amount of slop in timer>>                     02580000
                                                                        02582000
subroutine TIMEOUTMQE;                                                  02584000
                                                                        02586000
<<Function                                                              02588000
  Delete the MQE from the current port, mark as "timeout expired,"      02590000
  and place it on the end of the return port.>>                         02592000
                                                                        02594000
  begin                                                                 02596000
  <<Get the MQE's vital statistics>>                                    02598000
  @MQE:=TMQEaddress;                                                    02600000
  @port:=Tport'address;                                                 02602000
  MTLEaddress:=timeout'occurred;                                        02606000
  if mmstat'enabled then                                                02608000
    MMSTAT(MMtimeout'exp,port'num,@mqe,Mreturn'port);                   02610000
                                                                        02612000
  <<Find the MQE just in front of the target MQE>>                      02614000
  if PheadMQE = @MQE then                                               02616000
    begin  <<First MQE in the list>>                                    02618000
    if PtailMQE = @MQE then                                             02620000
      begin  <<Only MQE in the list>>                                   02622000
      if PpendingMQE <> 1 then UGLYPORTACCESS;                          02624000
      PheadMQE:=PtailMQE:=0;                                            02626000
      end                                                               02628000
    else                                                                02630000
      PheadMQE:=MnextMQE;                                               02632000
    end                                                                 02634000
  else                                                                  02636000
    begin  <<MQE is somewhere beyond the first entry in the queue>>     02638000
    tos:=PheadMQE;                                                      02640000
    while sp0 <> @MQE do s0:=sp0;                                       02642000
    sp0:=MnextMQE;                                                      02644000
    if MnextMQE.stopper'field = stopper then PtailMQE:=s0;              02646000
    del;                                                                02648000
    end;                                                                02650000
                                                                        02652000
  <<Place the timed out MQE onto the end of its return port>>           02654000
  if Mreturn'port <> 0 then                                             02656000
    begin                                                               02658000
    @return'port:=Mreturn'port&lsl(port'hash);                          02660000
    QUEUETOPORT(return'port,MQE,queue'to'tail);                         02662000
    end                                                                 02664000
  else                                                                  02666000
    PUTFREEBLOCK(MQE);                                                  02668000
  PpendingMQE:=PpendingMQE-1;                                           02670000
  end;  <<TIMEOUTMQE>>                                                  02672000
                                                                        02674000
                                                                        02676000
logical subroutine GETHEADTLE;                                          02678000
  begin                                                                 02680000
  if (@TLE:=GheadTLE) <> 0 then                                         02682000
    begin                                                               02684000
    GETHEADTLE:=true;                                                   02688000
    end;                                                                02690000
  end;  <<GETHEADTLE>>                                                  02692000
                                                                        02694000
                                                                        02696000
while port'mask <> 0 do                                                 02698000
  begin  <<Time outs pending on one or more port segments>>             02700000
  if port'mask then                                                     02702000
    begin  <<Timeout pending on next port segment>>                     02704000
    <<Initialize>>                                                      02706000
    portDST:=get'portDST;                                               02708000
    oldDST:=EXCHANGEDB(portDST);                                        02710000
    if portDST <> GDST then UGLYPORTACCESS;                             02712000
    pseudodisable;                                                      02714000
    ABORTTIMEREQ(Gtrlx);                                                02716000
    Gtrlx:=0;                                                           02718000
    current'time:=TIMER;                                                02720000
    if (elapsed'time:=current'time-Gstart'time) < 0d then               02722000
      elapsed'time:=elapsed'time+T24day'value;                          02724000
                                                                        02726000
    <<Pull expired timeout requests from the start of the timeout list>>02728000
    while GETHEADTLE and (elapsed'time+slop) > Ttime'increment do       02730000
      begin  <<The timeout expired on the head TLE>>                    02732000
      GheadTLE:=TnextTLE;                                               02734000
      elapsed'time:=elapsed'time-Ttime'increment;                       02736000
      TIMEOUTMQE;                                                       02738000
      PUTFREEBLOCK(TLE);                                                02742000
      end;                                                              02744000
                                                                        02746000
    <<If list is not empty, then start the timer>>                      02748000
    if @TLE <> 0 then                                                   02750000
      begin                                                             02752000
      TlastTLE:=0;                                                      02754000
      Ttime'increment:=Ttime'increment-elapsed'time;                    02756000
      Gstart'time:=current'time;                                        02758000
      Gtrlx:=TIMEREQ(port'timeout,1,Ttime'increment);                   02760000
      end;                                                              02762000
                                                                        02764000
    pseudoenable;                                                       02766000
    EXCHANGEDB(oldDST);                                                 02768000
    end;                                                                02770000
  port'number:=port'number+1;                                           02772000
  port'mask:=port'mask&lsr(1);                                          02774000
  end;                                                                  02776000
end;  <<FCPOSTIMEOUT>>                                                  02778000
$PAGE "INTRINSICS"                                                      02780000
integer procedure FCPORTOPEN(flags);                                    02782000
value flags;                                                            02784000
                                                                        02786000
<<Function                                                              02788000
  Creates a port for the calling process (port manager).  The           02790000
  port's initial state is disabled.>>                                   02792000
                                                                        02794000
<<Input                                                                 02796000
    DB                    Any data segment.>>                           02798000
  logical                                                               02802000
    flags;              <<Miscellaneous fields                          02804000
                          (15:1)  Action to take if no port             02806000
                                  space                                 02808000
                              0 - return                                02810000
                              1 - impede                                02812000
                          (14:1)  Port access restrictions              02814000
                              0 - only the creator can read/close       02816000
                              1 - unrestricted access                   02818000
                          Default is all zeroes.>>                      02820000
                                                                        02822000
<<Output                                                                02824000
  FCPORTOPEN              Port index (DST relative address of           02826000
                          the port.)                                    02828000
  condition Codes                                                       02830000
    cce                   Port acquired.                                02832000
    ccl                   No more space.>>                              02834000
                                                                        02836000
<<Algorithm                                                             02838000
  If port segment not extant then create it                             02840000
  Get a free entry                                                      02842000
  If entry obtained then                                                02844000
    begin                                                               02846000
    Initialize the port                                                 02848000
    Return cce                                                          02850000
    end                                                                 02852000
  else                                                                  02854000
    return ccl                                                          02856000
>>                                                                      02858000
option variable,privileged,uncallable;                                  02860000
                                                                        02862000
begin                                                                   02864000
define                                                                  02866000
  flag'spec                       = pmap.(15:1)#,                       02868000
  wake'type'spec                  = pmap.(14:1)#,                       02870000
  impede'flag                     = flags.(15:1)#,                      02872000
  access'restrict                 = flags.(14:1) = 0#;                  02874000
integer                                                                 02880000
  port'number=FCPORTOPEN,absolute'port'loc,portDST,callerDST,           02882000
  impede'type;                                                          02884000
pointer                                                                 02886000
  port;                                                                 02888000
                                                                        02890000
logical subroutine MAKEPORTSEG;                                         02892000
  begin                                                                 02894000
  portDST:=CREATEPORTSEG;                                               02896000
  pseudodisable;                                                        02898000
  if abs(absolute'port'loc) <> 0 then                                   02900000
    begin  <<Another process created the port segment.>>                02902000
    RELDATASEG(portDST);                                                02904000
    portDST:=abs(absolute'port'loc);                                    02906000
    end                                                                 02908000
  else                                                                  02910000
    abs(absolute'port'loc):=portDST;                                    02912000
  pseudoenable;                                                         02914000
  MAKEPORTSEG:=(portDST <> 0);                                          02916000
  end;  <<MAKEPORTSEG>>                                                 02918000
                                                                        02920000
<<Initialize>>                                                          02922000
if not flag'spec then flags:=0;                                         02924000
                                                                        02928000
<<If port segment not extant, then create it>>                          02930000
absolute'port'loc:=port'base'loc;                                       02932000
if (portDST:=abs(absolute'port'loc)) = 0                                02934000
  and not MAKEPORTSEG then                                              02936000
    condition'code:=ccl                                                 02938000
else                                                                    02940000
  begin  <<Block obtained, initialize it>>                              02942000
  callerDST:=EXCHANGEDB(abs(absolute'port'loc):=portDST);               02944000
  impede'type:=if impede'flag then impede'me else expand'seg;           02946000
  if (@port:=GETFREEBLOCK(impede'type)) <> 0 then                       02948000
    begin  <<Initialize the port>>                                      02950000
    Gnum'open'ports:=Gnum'open'ports+1;                                 02952000
    PheadMQE:=PtailMQE:=Pmisc:=PpendingMQE:=0;                          02954000
    Pport'pin:=                                                         02956000
      if access'restrict then (abs(CPCB)-abs(PCBB))/PCBlen else 0;      02958000
    Pwake'type:=awaken'process;                                         02960000
    port'addr'field:=@port&lsr(3);                                      02964000
    port'index:=0;                                                      02966000
    Pport'thread:=Gport'head;                                           02968000
    Gport'head:=port'addr'field;                                        02970000
    condition'code:=cce;                                                02972000
    end                                                                 02974000
  else                                                                  02976000
    condition'code:=ccl;                                                02978000
  EXCHANGEDB(callerDST);                                                02980000
  end;                                                                  02982000
if mmstat'enabled then                                                  02984000
  MMSTAT(MMopen,port'number,portDST,flags);                             02986000
end;  <<FCPORTOPEN>>                                                    02988000
logical procedure FCPORTCLOSE(port'number);                             02990000
value port'number;                                                      02992000
                                                                        02994000
<<Function                                                              02996000
  Deallocates the port.>>                                               02998000
                                                                        03000000
                                                                        03002000
<<Input                                                                 03004000
    DB                    Any data segment.>>                           03006000
  integer                                                               03008000
    port'number;        <<Number of the port.>>                         03010000
                                                                        03012000
<<Output                                                                03014000
  FCPORTCLOSE             True - request done.                          03016000
                          False- request not done because one or        03018000
                                 more messages were queued.>>           03020000
                                                                        03022000
<<Algorithm                                                             03024000
  If no messages then                                                   03026000
    begin                                                               03028000
    Release the port to the free area                                   03030000
    Return true                                                         03032000
    If no more ports in this port segment then                          03034000
      return the data segment                                           03036000
    end                                                                 03038000
  else                                                                  03040000
    Return false                                                        03042000
>>                                                                      03044000
option privileged,uncallable;                                           03046000
                                                                        03048000
begin                                                                   03050000
data'structure;                                                         03052000
integer                                                                 03054000
  absolute'port'loc,oldDST;                                             03056000
integer pointer                                                         03058000
  dummy,thread;                                                         03060000
                                                                        03062000
oldDST:=EXCHANGEDB(0);                                                  03064000
@port:=PREPPORT(port'number,only'manager,dummy,callerDST,caller'offset);03066000
pseudodisable;                                                          03068000
if PheadMQE = 0 then                                                    03070000
  begin                                                                 03072000
  if PpendingMQE <> 0 then UGLYPORTACCESS;                              03074000
  <<Delete port from the port thread>>                                  03078000
  if Gport'head = port'addr'field then                                  03080000
    Gport'head:=Pport'thread                                            03082000
  else                                                                  03084000
    begin  <<Port is somewhere into the thread>>                        03086000
    @thread:=Gport'head&lsl(3);                                         03088000
    while thread(thread'loc).port'thread <> port'addr'field do          03090000
      @thread:=(thread(thread'loc).port'thread)&lsl(3);                 03092000
    thread(thread'loc).port'thread:=Pport'thread;                       03094000
    end;                                                                03096000
  if mmstat'enabled then                                                03098000
    MMSTAT(MMclose,port'number,portDSTnumber,Gnum'open'ports-1);        03100000
  PUTFREEBLOCK(port);                                                   03102000
  FCPORTCLOSE:=true;                                                    03104000
  absolute'port'loc:=port'base'loc+port'index;                          03106000
  if (Gnum'open'ports:=Gnum'open'ports-1) = 0 then                      03108000
    begin                                                               03110000
    abs(absolute'port'loc):=0;                                          03112000
    pseudoenable;                                                       03114000
    RELDATASEG(EXCHANGEDB(0));                                          03116000
    pseudodisable;                                                      03118000
    end;                                                                03120000
  end;                                                                  03122000
pseudoenable;                                                           03124000
EXCHANGEDB(oldDST);                                                     03126000
end;  <<FCPORTCLOSE>>                                                   03128000
integer procedure FCPORTSEND(port'number,message,message'length,        03130000
  return'port,timeout,flags);                                           03132000
value port'number,message,message'length,return'port,                   03134000
  timeout,flags;                                                        03136000
                                                                        03138000
<<Function                                                              03140000
  Allocates, initializes, and queues an MQE to the tail of the          03142000
  port.>>                                                               03144000
                                                                        03146000
<<Input>>                                                               03148000
  integer                                                               03150000
    port'number;        <<Number of the port.>>                         03152000
  integer pointer                                                       03154000
    message;            <<Address of the message>>                      03156000
  integer                                                               03158000
    message'length,     <<Length of the message in words.>>             03160000
    return'port,        <<Port to send to when a timeout                03162000
                          occurs.  Default is no return port.>>         03164000
    timeout,            <<Number of seconds to wait to be               03166000
                          processed.  If the timeout expires            03168000
                          then the MQE will be deleted from the         03170000
                          queue and placed on the tail of the           03172000
                          return port.  Default is no timeout.          03174000
                          Set to zero for interrupt handlers.>>         03176000
    flags;              <<(15:1) - Manner to queue to the port          03178000
                                   0 - queue to tail                    03180000
                                   1 - queue to head                    03182000
                          (14:1) - Action to take if port is enabled    03184000
                                   0 - wake the process                 03186000
                                   1 - do not awaken the process,       03188000
                                       return its PCB pointer in        03190000
                                       FCPORTSEND>>                     03192000
                                                                        03194000
<<Output                                                                03196000
    FCPORTSEND            See queue'type parameter discussion           03198000
  condition code                                                        03200000
    cce                   Message sent.                                 03202000
    ccl                   Message not sent because no MQE could         03204000
                          be obtained.>>                                03206000
                                                                        03208000
<<Algorithm                                                             03210000
  Get an MQE entry (impede if no MQE available and in process           03212000
  environment).                                                         03214000
  Move parameters into the entry                                        03216000
  If port is empty then                                                 03218000
    queue to the head                                                   03220000
  else                                                                  03222000
    queue as per queue'type specification                               03224000
  If this is the only message on the queue then                         03226000
    awaken the port manager as per port wake type                       03228000
>>                                                                      03230000
option variable,privileged,uncallable;                                  03232000
                                                                        03234000
begin                                                                   03236000
define                                                                  03238000
  queue'type                      = flags.(15:1)#,                      03240000
  flags'spec                      = pmap.(15:1) #,                      03242000
  timeout'spec                    = pmap.(14:1) #,                      03244000
  return'port'spec                = pmap.(13:1) #,                      03246000
  message'length'spec             = pmap.(12:1) #;                      03248000
data'structure;                                                         03250000
                                                                        03252000
@port:=PREPPORT(port'number,any'accessor,message,callerDST,             03254000
  caller'offset);                                                       03256000
if not flags'spec then flags:=0;                                        03258000
if (@MQE:=GETFREEBLOCK(impede'me)) = 0 then                             03260000
  condition'code:=ccl                                                   03262000
else                                                                    03264000
  begin  <<Got a free entry>>                                           03266000
  condition'code:=cce;                                                  03268000
                                                                        03270000
  <<Initialize the message>>                                            03272000
  Mreturn'port:=if return'port'spec then return'port else 0;            03274000
  if message'length'spec and message'length <> 0 then                   03276000
    begin                                                               03278000
    tos:=portDSTnumber;                                                 03280000
    tos:=@Mparameter0;                                                  03282000
    tos:=caller'address;                                                03284000
    tos:=message'length;                                                03286000
    asmb(MDS 5);                                                        03288000
    end;                                                                03290000
  pseudodisable; <<Don't allow tables to be partially updated>><<04984>>03291000
  if timeout'spec and timeout <> 0 then                                 03292000
    STARTIMEOUT(MQE,port,port'index,timeout)                            03294000
  else                                                                  03296000
    MtLEaddress:=0;                                                     03298000
  FCPORTSEND:=QUEUETOPORT(port,MQE,flags);                              03300000
  pseudoenable;                                                <<04984>>03301000
  if mmstat'enabled then                                                03302000
    MMSTAT(MMsend,port'number,@MQE+queue'type,return'port);             03304000
  end;                                                                  03306000
EXCHANGEDB(0);                                                          03308000
end;  <<FCPORTSEND>>                                                    03310000
procedure FCPORTDISABLE(port'number);                                   03312000
value port'number;                                                      03314000
                                                                        03316000
<<Function                                                              03318000
  disables wake ups/soft interrupts on the port.>>                      03320000
                                                                        03322000
<<Input>>                                                               03324000
  integer                                                               03326000
    port'number;        <<Number of the port.>>                         03328000
                                                                        03330000
<<Output                                                                03332000
  Condition code          cce - no messages                             03334000
                          ccl - one or more messages queued>>           03336000
option privileged,uncallable;                                           03338000
                                                                        03340000
begin                                                                   03342000
integer array                                                           03344000
  port(0:port'size);                                                    03346000
                                                                        03348000
QUICKPREPPORT(port'number,port);                                        03350000
Penable:=false;                                                         03352000
tos:=if PheadMQE = 0 then cce else ccl; condition'code:=tos;            03354000
if mmstat'enabled then                                                  03356000
  MMSTAT(MMchange'state,port'number,MMdisable'port,PheadMQE);           03358000
QUICKUNPREPPORT(port'number,port);                                      03360000
end;  <<FCPORTDISABLE>>                                                 03362000
logical procedure FCPORTENABLE(port'number);                            03364000
value port'number;                                                      03366000
                                                                        03368000
<<Function                                                              03370000
  Enable wakeups/soft interrupts on the port.  If the port is           03372000
  not empty and wake'type <> software interrupt, then no PCB            03374000
  wake field is set.>>                                                  03376000
                                                                        03378000
<<Input>>                                                               03380000
  integer                                                               03382000
    port'number;        <<Number of the port.>>                         03384000
                                                                        03386000
<<Output                                                                03388000
  FCPORTENABLE            Status of the port.                           03390000
                          False - port has no messages (CCE cond code)  03392000
                          True  - port has messages (CCL cond code)>>   03394000
                                                                        03396000
option privileged,uncallable;                                           03398000
                                                                        03400000
begin                                                                   03402000
integer array                                                           03404000
  port(0:port'size);                                                    03406000
                                                                        03408000
QUICKPREPPORT(port'number,port);                                        03410000
if Pport'pin = 0 then UGLYPORTACCESS;                                   03412000
if PheadMQE <> 0 then  <<Software interrupt not implemented>>           03414000
  begin                                                                 03416000
  FCPORTENABLE:=true;                                                   03418000
  tos:=ccl;                                                             03420000
  if Pwake'type > 0 then CAUSEOWNSOFTINT(port);                         03422000
  end                                                                   03424000
else                                                                    03426000
  begin                                                                 03428000
  Penable:=true;                                                        03430000
  tos:=cce;                                                             03432000
  end;                                                                  03434000
condition'code:=tos;                                                    03436000
if mmstat'enabled then                                                  03438000
  MMSTAT(MMchange'state,port'number,MMenable'port,PheadMQE);            03440000
QUICKUNPREPPORT(port'number,port);                                      03442000
end;  <<FCPORTENABLE>>                                                  03444000
integer procedure FCPORTRECEIVE(port'number,message,message'length,     03446000
  flags);                                                               03448000
value port'number,message,message'length,flags;                         03450000
                                                                        03452000
<<Function                                                              03454000
  Tests if the port has a message.  If so then the message is           03456000
  dequeued and the information returned.>>                              03458000
                                                                        03460000
<<Input>>                                                               03462000
  integer                                                               03464000
    port'number;        <<Number of the port.>>                         03466000
  integer pointer                                                       03468000
    message;            <<Address of the message>>                      03470000
  integer                                                               03472000
    message'length;     <<Length of the message in words.>>             03474000
  logical                                                               03476000
    flags;              <<Miscellaneous flags                           03478000
                          15:1 Action to be taken if port empty         03480000
                           0 - return                                   03482000
                           1 - wait                                     03484000
                          14:1 Message deletion                         03486000
                           0 - Delete the message                       03488000
                           1 - Leave the message                        03490000
                          13:1 Enable soft interrupts                   03492000
                           0 - Leave disabled                           03494000
                           1 - Reenable                                 03496000
                          Note - optional variable, default is 0>>      03498000
                                                                        03500000
<<Output                                                                03502000
  condition code                                                        03504000
    cce                   Message was received                          03506000
    ccg                   Port was empty                                03508000
    ccl                   A timeout occurred on a sent message          03510000
                                                                        03512000
    FCPORTRECEIVE         Return port.>>                                03514000
                                                                        03516000
<<Algorithm                                                             03518000
  If port is empty then                                                 03520000
    begin                                                               03522000
    If no wait then                                                     03524000
      return ccg                                                        03526000
    else                                                                03528000
      long wait for a message to be received                            03530000
    end                                                                 03532000
  if specified then dequeue the message                                 03534000
  Pass back the message parameters                                      03536000
  if specified then return the MQE to the free list                     03538000
>>                                                                      03540000
option variable,privileged,uncallable;                                  03542000
                                                                        03544000
begin                                                                   03546000
integer                                                                 03548000
  return'port=FCPORTRECEIVE,iflags=flags;                               03550000
equate                                                                  03552000
  long'wait                       = 1;                                  03554000
define                                                                  03556000
  waitspec                        = flags.(15:1)#,                      03558000
  delete'msg                      = not(flags.(14:1))#,                 03560000
  reenable                        = flags.(13:1)#;                      03562000
data'structure;                                                         03564000
                                                                        03566000
logical subroutine EMPTYPORT;                                           03568000
  begin                                                                 03570000
  if PheadMQE = 0 then                                                  03572000
    begin                                                               03574000
    if PpendingMQE <> 0 then UGLYPORTACCESS;                            03576000
    EMPTYPORT:=true;                                                    03578000
    end;                                                                03580000
  end;  <<EMPTYPORT>>                                                   03582000
                                                                        03584000
                                                                        03586000
if not pmap then flags:=0;                                              03588000
@port:=PREPPORT(port'number,only'manager,message,callerDST,             03590000
  caller'offset);                                                       03592000
                                                                        03594000
<<Get the message>>                                                     03596000
if EMPTYPORT and (not waitspec or Pwake'type <> 0) then                 03598000
  condition'code:=ccg                                                   03600000
else                                                                    03602000
  begin                                                                 03604000
  while EMPTYPORT do                                                    03606000
    begin                                                               03608000
    Penable:=true;                                                      03610000
    WAIT(-port'wake,long'wait);  <<Wait for msg to arrive>>             03612000
    end;                                                                03614000
                                                                        03616000
  <<Process the head message>>                                          03618000
  pseudodisable;                                                        03620000
  @MQE:=PheadMQE;                                                       03622000
  if delete'msg then                                                    03624000
    begin                                                               03626000
    PpendingMQE:=PpendingMQE-1;                                         03628000
    if (PheadMQE:=MnextMQE) = MQEstopper then                           03630000
      begin                                                             03632000
      if PpendingMQE <> 0 then UGLYPORTACCESS;                          03634000
      PheadMQE:=PtailMQE:=0;                                            03636000
      end;                                                              03638000
    end;                                                                03640000
$EDIT                                                          <<04984>>03642000
  if message'length <> 0 then                                           03644000
    begin                                                               03646000
    tos:=caller'address;                                                03648000
    tos:=portDSTnumber;                                                 03650000
    tos:=@Mparameter0;                                                  03652000
    tos:=message'length;                                                03654000
    asmb(MDS 5);                                                        03656000
    end;                                                                03658000
  FCPORTRECEIVE:=Mreturn'port;                                          03660000
  condition'code:=if MTLEaddress = timeout'occurred then ccl else cce;  03662000
  ABORTIMER(MQE);                                                       03664000
  pseudoenable;                                                <<04984>>03665000
  if delete'msg then PUTFREEBLOCK(MQE);                                 03666000
  if mmstat'enabled then                                                03668000
    MMSTAT(MMreceive'completion,port'number,@MQE+iflags,return'port);   03670000
  end;                                                                  03672000
                                                                        03674000
<<Check if should reenable soft interrupts>>                            03676000
if reenable and Pwake'type > 0 then                                     03678000
  begin                                                                 03680000
  if PheadMQE = 0 then                                                  03682000
    Penable:=1                                                          03684000
  else                                                                  03686000
    CAUSEOWNSOFTINT(port);                                              03688000
  end;                                                                  03690000
EXCHANGEDB(0);                                                          03692000
end;  <<FCPORTRECEIVE>>                                                 03694000
integer procedure FCPORTSTATUS(port'number,info'type);                  03696000
value port'number,info'type;                                            03698000
                                                                        03700000
<<Function                                                              03702000
  Returns information about the port.>>                                 03704000
                                                                        03706000
<<Input>>                                                               03710000
  integer                                                               03712000
    port'number,        <<Number of the port.>>                         03714000
    info'type;          <<Type of info desired.                         03716000
                          0 - number of outstanding msgs                03718000
                          1 - number of seconds left in timeout>>       03720000
                                                                        03722000
<<Output                                                                03724000
    FCPORTSTATUS          The value of the information.>>               03726000
option privileged,uncallable;                                           03728000
                                                                        03730000
begin                                                                   03732000
equate                                                                  03734000
  num'pend'msgs                   = 0,                                  03736000
  current'timeout                 = 1,                                  03738000
  max'info'type                   = 1;                                  03740000
integer                                                                 03742000
  return'value=FCPORTSTATUS;                                            03744000
integer pointer                                                         03746000
  dummy,TLE;                                                            03748000
double pointer                                                 <<03034>>03750000
  TLED=TLE;                                                    <<03034>>03752000
double                                                                  03754000
  elapsed'time;                                                         03756000
data'structure;                                                         03758000
                                                                        03760000
if info'type > max'info'type then UGLYPORTACCESS;                       03762000
@port:=PREPPORT(port'number,any'accessor,dummy,callerDST,caller'offset);03764000
pseudodisable;                                                          03766000
@mqe:=PheadMQE;                                                         03768000
case info'type of                                                       03770000
  begin                                                                 03772000
  begin  <<** Return number of pending messages>>                       03774000
  return'value:=PpendingMQE;                                            03776000
  end;                                                                  03778000
  begin  <<** Return the timeout value of port's first message>>        03780000
  if (@TLE:=MTLEaddress) <> 0 then                                      03782000
    begin  <<Timeout exists against the head mqe>>                      03784000
    if (elapsed'time:=Ttarget'time-TIMER) < 0d then            <<03034>>03786000
      begin  <<Current time greater than expire time>>         <<03034>>03788000
      elapsed'time:=elapsed'time+T24day'value;<<Adjust modulo>><<03034>>03790000
      if elapsed'time > 65534000d then  <<Beyond 64k secs?>>   <<03034>>03792000
        elapsed'time:=0d;  <<Yes, timeout has expired>>        <<03034>>03794000
      end;                                                     <<03034>>03796000
    return'value:=log(elapsed'time/1000d);                              03798000
    if return'value <= 0 then return'value:=1;                 <<03034>>03800000
    end;                                                                03802000
  end;                                                                  03804000
  end;  <<Case>>                                                        03806000
pseudoenable;                                                           03808000
EXCHANGEDB(0);                                                          03810000
end;  <<FCPORTSTATUS>>                                                  03812000
procedure FCPORTCONTROL(port'number,type,parm);                         03814000
value port'number,type,parm;                                            03816000
                                                                        03818000
<<Function                                                              03820000
  Changes the port's characteristics.>>                                 03822000
                                                                        03824000
<<Input>>                                                               03826000
  integer                                                               03828000
    port'number,        <<Number of the port.>>                         03830000
    type;               <<Type of change desired.                       03832000
                          0 - change software interrupts>>              03834000
  integer pointer                                                       03836000
    parm;               <<Array containing the change particulars.>>    03838000
                                                                        03840000
<<Output                                                                03842000
    None.>>                                                             03844000
option privileged,uncallable;                                           03846000
                                                                        03848000
begin                                                                   03850000
data'structure;                                                         03852000
equate                                                                  03854000
  max'type          = 0,                                                03856000
  no'interrupt      = -1,                                               03858000
  max'parm          = 4;                                                03860000
integer array                                                           03862000
  local'parm(0:max'parm)=q;                                             03864000
integer                                                                 03866000
  dummy;                                                                03868000
define                                                                  03870000
  interrupt'type   = local'parm#,                                       03872000
  soft'subtype     = local'parm(1)#,                                    03874000
  soft'parameter   = local'parm(2)#,                                    03876000
  soft'int'plabel  = local'parm(3)#;                                    03878000
                                                                        03880000
                                                                        03882000
move local'parm:=parm,(max'parm);                                       03884000
if type > max'type then UGLYPORTACCESS;                                 03886000
@port:=PREPPORT(port'number,only'manager,dummy,dummy,dummy);            03888000
case type of                                                            03890000
  begin                                                                 03892000
  begin  <<** Software interrupt>>                                      03894000
  if interrupt'type = no'interrupt then                                 03896000
    Pwake'type:=awaken'process                                          03898000
  else                                                                  03900000
    begin                                                               03902000
    Pwake'type:=interrupt'type+1;                                       03904000
    Psoft'int'plabel:=soft'int'plabel;                                  03906000
    Psoft'subtype:=soft'subtype;                                        03908000
    Psoft'parameter:=soft'parameter;                                    03910000
    end;                                                                03912000
  end;                                                                  03914000
  end;  <<case>>                                                        03916000
EXCHANGEDB(0);                                                          03918000
end;  <<FCPORTCONTROL>>                                                 03920000
integer procedure                                                       03922000
  FCMSGABORT(port'number,return'port,parameter'value);                  03924000
value port'number,return'port,parameter'value;                          03926000
                                                                        03928000
<<Function                                                              03930000
  Dequeues from the port all messages having 1) a matching              03932000
  return port and 2) (optionally) a parameter zero value matching       03934000
  parameter'value.  This procedure may not be used on a port            03936000
  accessed by an interrupt handler.>>                                   03938000
                                                                        03940000
<<Input>>                                                               03942000
  integer                                                               03944000
    port'number,        <<Number of the port.>>                         03946000
    return'port,        <<MQEs' return port.>>                          03948000
    parameter'value;    <<Value of parameter zero.  If not              03950000
                          specified, then no test is made.>>            03952000
                                                                        03954000
<<Output                                                                03956000
    FCMSGABORT             Number of messages deleted.>>                03958000
option variable,privileged,uncallable;                                  03960000
                                                                        03962000
begin                                                                   03964000
data'structure;                                                         03966000
define                                                                  03968000
  parm'zero'spec                  = pmap#;                              03970000
pointer                                                                 03972000
  dummy,lastMQE;                                                        03974000
integer                                                                 03976000
  numMQE'aborted=FCMSGABORT,stopper;                                    03978000
                                                                        03980000
@port:=PREPPORT(port'number,any'accessor,dummy,callerDST,caller'offset);03982000
pseudodisable;                                                          03984000
@lastMQE:=@PheadMQE;                                                    03986000
if lastMQE <> 0 then                                                    03988000
  begin                                                                 03990000
  @MQE:=lastMQE;                                                        03992000
  stopper:=MQEstopper;                                                  03994000
  while (@MQE:=lastMQE) <> stopper do                                   03996000
    begin                                                               03998000
    if Mreturn'port = return'port                                       04000000
    and (not parm'zero'spec or Mparameter0 = parameter'value) then      04002000
      begin  <<Match, delete from the queue>>                           04004000
      numMQE'aborted:=numMQE'aborted+1;                                 04006000
      if int(lastMQE:=MnextMQE) = stopper then                 <<03034>>04008000
         PtailMQE:=@lastMQE;                                   <<03034>>04010000
      ABORTIMER(MQE);                                                   04012000
      PpendingMQE:=PpendingMQE-1;                                       04014000
      PUTFREEBLOCK(MQE);                                                04016000
      end                                                               04018000
    else                                                                04020000
      @lastMQE:=@MQE;                                                   04022000
    end;                                                                04024000
  if PheadMQE = stopper then                                            04026000
    begin  <<Port is empty>>                                            04028000
    if PpendingMQE <> 0 then UGLYPORTACCESS;                            04030000
    PheadMQE:=PtailMQE:=0;                                              04032000
    end;                                                                04034000
  end;                                                                  04036000
pseudoenable;                                                           04038000
condition'code:=if numMQE'aborted <> 0 then cce else ccl;               04040000
EXCHANGEDB(0);                                                          04042000
if mmstat'enabled then                                                  04044000
  MMSTAT(MMabort,port'number,parameter'value,return'port);              04046000
end;  <<FCMSGABORT>>                                                    04048000
double procedure FCPORTVERSION;                                         04050000
                                                                        04052000
<<Function                                                              04054000
  Returns software version and update number.                           04056000
  Note - this procedure should be the last in the listing so            04058000
         that it will be the first in the segment, hence easy to        04060000
         find the PB array with debug.>>                                04062000
                                                                        04064000
<<Input                                                                 04066000
  None.>>                                                               04068000
                                                                        04070000
<<Output                                                                04072000
  FCPORTVERSION          Least significant word - Version number        04074000
                         Most significant word  - Update number>>       04076000
                                                                        04078000
begin                                                                   04080000
integer                                                                 04082000
  return'version=q-5,return'update=q-4;                                 04084000
array                                                                   04086000
  version'array(0:1)=pb:=version,update;                                04088000
                                                                        04090000
return'version:=version; return'update:=update;                         04092000
end;  <<FCPORTVERSION>>                                                 04094000
$PAGE "OUTER BLOCK."                                                    04096000
$CONTROL SEGMENT=OUTERBLOCK                                             04098000
end.                                                                    04100000
