                                                                        00001000
$page "MPE Ports Facility"                                              00002000
<< X5 compile time flag --- MPE V/E data structures >>                  00003000
$SET X5 = ON                                                            00004000
$control map,code,uslinit,privileged,uncallable                         00005000
begin                                                                   00006000
$page "MPE Ports Facility Version History"                              00099000
$COPYRIGHT "(c) Copyright Hewlett-Packard Company 1983.  All ",   &     00100000
$          "rights reserved.  This program may be used with ",    &     00102000
$          "one computer system at a time and shall not ",        &     00104000
$          "otherwise be recorded, transmitted or stored in a ",  &     00106000
$          "retrieval system.  Copying or other reproduction of ",&     00108000
$          "this program is prohibited without the prior ",       &     00110000
$          "written consent of Hewlett-Packard Company."                00112000
                                                                        00114000
COMMENT   ---------------- Version History ------------------           00116000
  MPE IV and V/P:                                                       00118000
     A.00.00     - version in use up to 5-5-83                          00120000
     A.01.00     - PortEnable & PortDisable made type logical. 5-6-83   00122000
     A.01.01     - SoftIntPlabel added. 5-6-83                          00124000
     A.01.02     - SysGlobExt cell & AltDSegSize fixed.  5-9-83         00126000
     A.01.03     - same as B.01.04  5-12-83                             00128000
     A.01.04     - same as B.01.05  5-25-83                             00130000
     A.01.05     - same as B.01.06  6-7-83                              00132000
     A.02.03.012 - altered 'lock' and 'unlock' to accept a pin #        00134000
                   for queueing purposes in dictionary.                 00136000
                   8/7/84         Lloyd Spencer (LTS)           00035   00138000
     A.02.03.013 - 1. modified "lock" and "unlock", placing             00140000
                      queueing code directly in line.                   00142000
                   2. Modification needed to address SYSPORT'PIN        00144000
                      in sysglob extension %120 for V/P version,        00146000
                      instead of sysglob extension %102 as              00148000
                      previously implemented in V/P.                    00150000
                   8/20/84        LTS                           00036   00152000
     A.02.03.013 - Refer to B.02.03.014.                                00154000
  MPE V/E:                                                              00156000
     B.01.02 - first version given to CSY. 5-9-83                       00158000
     B.01.03 - changed some pcbx's back to pins. 5-10-83                00160000
     B.01.04 - FetchSeg, SegCompletor, IOWaitDisp fixes. 5-12-83        00162000
     B.01.05 - altered size of ports. added InitPortDST' and            00164000
               CreatePort' and CreatIOWaitPort'.  5-25-83               00166000
     B.01.06 - redid WaitforMsg and timers      6-7-83                  00168000
     B.01.07 - softint to iowait mode bug  6-23-83              00001   00170000
             - result code in Create'IOwaitport                 00002   00172000
     B.01.08 - provide default aft cleanup 06/29/83             00003   00174000
             - added better error checking 7-6-83               00004   00176000
     B.02.01 - allocated separate pools for portCB, context     00005   00178000
               area, and msg frame. Got rid of old              00005   00180000
               InitPortDST.           7-10-83                   00005   00182000
     B.02.01.01 - added two words to portheader for STUD        00006   00184000
                see Rick Bartlett  07-25-83                             00186000
     B.02.01.02 - added begin/end to defines and extra          00007   00188000
                  fields to port dst header 7/29/83             00007   00190000
     B.02.01.03 - corrected DSTSize Calculation 8/5/83          00008   00192000
     B.02.01.04 - fixed IOWaitPortDispatcher  8/11/83           00009   00194000
                  removed extraneous timer call  8/26/83        00011   00196000
     B.02.01.05 - zero out PortDST by myself  09/06/83          00013   00198000
     B.02.01.06 - changed SysPort sq 3 to 0   9/9/83            00014   00200000
     B.02.02.01 - replace SendMsg, RcvMsg, PortStatus with      00015   00202000
                  "non-enabling" versions.  09/09/83            00015   00204000
     B.02.02.02 - changed SysPort sq 0 to 4   9/21/83           00016   00206000
     B.02.02.03 - fixed sq enable in Receive'Wait 10/06/83      00017   00208000
     B.02.02.04 - fixed iowait & dict dst expansion 10/17/83    00018   00210000
     B.02.02.05 - delayed deletion of portdst  11/22/83         00019   00212000
     B.02.02.06 - fixed sf#617 on Deleteport 1/11/84            00020   00214000
     B.02.02.07 - fixed cleanup when createport' is out                 00216000
                  of context frames.  1/12/84                   00021   00218000
     B.02.02.08 - fixed waiting window in ReceiveMsg 1/20/84    00022   00220000
     B.02.02.09 - fixed GetMessage'Ref to zero the frame only   00023   00222000
                 if one is available.  2/2/84                   00023   00224000
     B.02.03.01 - rewrote timers.   2/5/84                      00024   00226000
     B.02.03.02 - changed 24day to 24hr rollover 2/27/84        00025   00228000
     B.02.03.03 - fixed bug in PortTimeOut  03/07/83            00026   00230000
     B.02.03.04 - added SetPortMask Procedure 3/15/84           00027   00232000
     B.02.03.05 - added GetMessageRef   3/22/84                 00028   00234000
     B.02.03.06 - workaround for LoadProc in V/E. 03/19/84      00029   00236000
     B.02.03.07 - added ChangePort.    04/03/84                 00030   00238000
     B.02.03.08 - disable port after send from ICS 4/11/84      00031   00240000
     B.02.03.09 - fixed change to PortDispatcher 4/16/84        00032   00242000
     B.02.03.10 - put check for msglen < 0 in rcvmsg 6/15/84            00244000
                  fixed halt 9 in DeletePortDST.                        00246000
                  6/27/84         RAB                           00033   00248000
                                                                        00250000
     B.02.03.11 - replaced obtain/release in port dictionary            00252000
                  to prevent SF 617.                                    00254000
                  7/22/84         RAB                           00034   00256000
     B.02.03.12 - refer to A.02.03.012                          00035   00258000
     B.02.03.13 - placed queueing code for dictionary locking           00260000
                  in the main dictionary procedure.                     00262000
                  8/18/84         LTS                           00036   00264000
     B.02.03.14 - Procedure Send (SendDB, S, Q, REF)                    00266000
                  Sending a message to a terminated or a deleted        00268000
                  port will result a suddendeath(badport).              00270000
                  8/28/84         LTS                           00037   00272000
                                                                        00274000
     B.02.03.16 - 1. createiowaitport. definitions out of order.        00276000
                  2. define Release'PortCB'Frame. The port control      00278000
                     free bit (word 4, bit 13) is set on its release.   00280000
                  3. procedure DeletePort. negate the absolute value    00282000
                     of MaxDstPorts d.t. multiple calls of DeletePort.  00284000
                  10/18/84       LTS                            00038   00286000
                                                                        00288000
     B.02.03.17 - procedure NewPortStatus. added 4 functional returns:  00290000
                                                                        00292000
                     Type (input)          Functional Return            00294000
                     ------------          -----------------            00296000
                          3                DB offset to user            00298000
                                           reserved region              00300000
                          4                Maximum number of            00302000
                                           ports in DST                 00304000
                          5                Current number of            00306000
                                           ports in DST                 00308000
                          6                Maximum message              00310000
                                           sixe for port DST            00312000
                          7                Port DST index               00314000
                                                                        00316000
                   Note that although the parameter PortId (double)     00318000
                   is passed in, only word 0 (port DST number) of       00320000
                   PortId will be used by NewPortStatus in returning    00322000
                   these functional values, word 1 being ignored.       00324000
                   10/24/84      LTS                            00040   00326000
                                                                        00328000
     B.02.03.19 - ChangeIOWaitPort. Set PortCB'enabled flag BEFORE      00330000
                  "exchange'db'back" is done.                           00332000
                  11/4/84        LTS                            00042   00334000
                                                                        00336000
     B.02.03.21 - 1. PortDispatcher. use a per process counter          00338000
                  to limit calling of penabled type port procedures     00340000
                  by a single process. Per process counter stored       00342000
                  in the context pointer cell of the per process        00344000
                  port. System max counter stored in sysglob            00346000
                  extension %124. In addition, if executing a           00348000
                  penabled type port, temporarily store the current     00350000
                  process pin in the portcb'pin cell.                   00352000
                  2. Send. bump the priority of a process currently     00354000
                  executing a port procedure if the port is active,     00356000
                  the port is a penabled type port, and not on the      00358000
                  interrupt control stack.                              00360000
                  11/14/84       LTS                            00044   00362000
     B.02.04.00 - 1. incrementiowaitcount. check if current             00364000
                     process is owner of the port.                      00366000
                  2. suddendeath if attempt a receivewait on an         00368000
                     iowait port.                                       00370000
                  3. resequence ports and reformat port                 00372000
                     data structure source code.                        00374000
                  12/13/84       LTS                            00046   00376000
                                                                        00378000
     ================= end of version history =====================     00380000
;  << ========== end of version history ==========>>                    00382000
$page "MPE Ports Facility"                                              00999000
                                                                        01000000
<< ========== ports version stamp ========== >>                         01001000
                                                                        01002000
$if X5 = off                                                            01003000
  define port'versionid = "A0204000"#;                      <<00046>>   01004000
$if X5 = on                                                             01005000
  define port'versionid = "B0204000"#;                      <<00046>>   01006000
$if                                                                     01007000
                                                                        01008000
                                                                        01009000
$page "MPE data structures and definitions"                             01010000
<< ===== defines for MPE data structures ===== >>                       01011000
define asmb = assemble#,                                                01012000
       abs = absolute#,                                                 01013000
$IF  X5=OFF                                                             01014000
       curpin  = (abs(cpcb) - abs(pcbb))/pcbsize#,                      01015000
       pcb'iqptr = 8#,  iqptr = (8:8)#,                                 01016000
       last'error'no = pxfile(4).(8:8)#,                                01017000
       pcb'xds = abs(x).(1:10)#,                                        01018000
$IF  X5=ON                                                              01019000
       curpin  = abs(cpcb)/pcbsize#,                                    01020000
       pcb'iqptr = 17#,                                                 01021000
       last'error'no = pxfile(2).(1:15)#,                               01022000
       pcb'xds = pcb(x).(2:14)#,                                        01023000
$IF                                                                     01024000
       to'xds = abs(cpcb) + 2#,  << offset to xds in pcb >>             01025000
       max'pin = pcb(0)#,                                               01026000
       max'serve  = sysglobext(%124)#,                      <<00044>>   01027000
       SysPort'pin = sysglobext(%120)#,                                 01028000
       disprunningflag = (0:1)#, << MPE 4? >>                           01029000
       pausedflag = (15:1)#,     << MPE 4? >>                           01030000
       aft'type = aft.(0:4)#,   << AFT type, admin by filesys >>        01031000
       aft'subtype = aft.(4:4)#;  << AFT subtype, admin by Ports >>     01032000
                                                                        01033000
comment : -----------------------------------------------------------   01034000
                                                                        01035000
          aft subtype       description                                 01036000
          -----------       -----------------------                     01037000
             %15            DS - IPC aft                                01038000
             %12            SNA Transport aft                           01039000
             %7             DS application services                     01040000
             %5             IMF aft                                     01041000
             %2             Remote File Access                          01042000
                              and PTOP                                  01043000
;                                                                       01044000
                                                                        01045000
equate sysdispawakemsg = %1050,  << MPE 4? >>                           01046000
       sysawakeschedmsg = %1052, << MPE 4? >>                           01047000
       QI = 5,  << Initial stack marker on ICS.  Same as ICS base. >>   01048000
       pcbb = 3,                                                        01049000
       cpcb = 4,  << low core addresses >>                              01050000
       MsgHarbTabDSTN = %71,  << system PortDST >>                      01051000
       MsgHarbPortLength = 16,  << sytem PortLength >>                  01052000
       IOWait'PortId'DST = %72,  << system IOWAIT PortId map table >>   01053000
$IF  X5=OFF                                                             01054000
       pcbsize = %20,                                                   01055000
       aftsize = 4,   << for addressing the aft >>                      01056000
       to'pxaftsize = 5,                                                01057000
       to'ioqx = 3,                                                     01058000
$IF  X5=ON                                                              01059000
       pcbsize = %25,                                                   01060000
       aftsize = 6,                                                     01061000
       to'pxaftsize = 6,                                                01062000
       to'ioqx = 5,                                                     01063000
$IF                                                                     01064000
       aft'base = 4,                                                    01065000
       softintpend = -2,  << aft(3) when softint enabled >>             01066000
       iowaitport'type = 9;                                             01067000
                                                                        01068000
                                                                        01069000
integer x = x;                                                          01070000
                                                                        01071000
integer pointer cst        = 1,    << pointer to cst table >>           01072000
                dst        = 2,    <<   "     "  dst   "   >>           01073000
                pcb        = 3,    <<   "     "  pcb   "   >>           01074000
                sysglobext = %377; << pointer to sysglob                01075000
                                      extension area       >>           01076000
                                                                        01077000
                                                                        01078000
<< ===== end of MPE data structures =====>>                             01079000
$page "Byte move data structures and definitions"                       01080000
<< ===== definitions for byte move procedures ===== >>                  01081000
                                                                        01082000
equate                                                                  01083000
   mpe4'entlen = %20;     << PCB entlen; = %25 for mpe5 >>              01084000
                                                                        01085000
define                                                                  01086000
   dst'maxp    = dst(0)#,                                               01087000
   dst'entlen  = lsl(2)#,                                               01088000
   dst'seglen  = lsl(3)&lsr(1)#,                                        01089000
   pcb'entlenp = pcb(1)#,                                               01090000
   qstat'cce   = tos:=qstat;tos.(6:1):=1;tos.(7:1):=0;qstat:=tos#,      01091000
   ccf         = (6:2)#,                                                01092000
   switch'db   = push(db);                                              01093000
                 if tos = %1000d then                                   01094000
                 begin                                                  01095000
                    at'sysdbi:=at'sysdbi-1;                             01096000
                    resetdb(-1);                                        01097000
                 end;                                                   01098000
                 save'dst:=exchangedb#,                                 01099000
   restore'db  = tos:=exchangedb(save'dst);                             01100000
                 if at'sysdb then tos:=setsysdb#;                       01101000
integer                                                                 01102000
   s0     = s-0,                                                        01103000
   s1     = s-1,                                                        01104000
   s2     = s-2,                                                        01105000
   qstat  = q-1;                                                        01106000
logical                                                                 01107000
   cy:=false,                                                           01108000
   lx     = x,                                                          01109000
   ls0    = s-0;                                                        01110000
integer pointer                                                         01111000
   ps0    = s-0;                                                        01112000
                                                                        01113000
<< ===== end of move byte procedure data structures ===== >>            01114000
$page "Port facility data structures and definitions"                   01115000
<< ===== definitions for port procedures ===== >>                       01116000
                                                                        01117000
define                                                                  01118000
  pdisable = asmb( psdb )#,                                             01119000
  penable  = asmb( pseb )#,                                             01120000
  disable = asmb( sed 0 )#,                                             01121000
  enable  = asmb( sed 1 )#,                                             01122000
  cc = OldStatus.(6:2)#,                                                01123000
  turn'traps'off = << disable arithmetic traps >>                       01124000
    begin                                                               01125000
      push(status);                                                     01126000
      tos.(2:1) := false;                                               01127000
      set(status);                                                      01128000
    end#;                                                               01129000
                                                                        01130000
equate                                                                  01131000
  << the infamous port "error messages" via suddendeath            >>   01132000
  badport     = 620,                                                    01133000
  wrongdst    = 621,                                                    01134000
  badportcall = 622,                                                    01135000
                                                                        01136000
  << port data segment size, and message harbor table size         >>   01137000
  PortDSTHeaderSize = 24,                                   <<00024>>   01138000
  MsgHarbHeaderSize = 13,                                   <<00005>>   01139000
  SubqueuesOffset   = 3,                    << double index        >>   01140000
                                                                        01141000
  << return condition codes >>                                          01142000
  cce = 2,                                                              01143000
  ccg = 0,                                                              01144000
  ccl = 1,                                                              01145000
                                                                        01146000
  << message formats >>                                                 01147000
  msg'link   = 0,                                                       01148000
  msg'length = 1,                                                       01149000
  msg'data   = 2,                                                       01150000
                                                                        01151000
  noinfo = 0,   << wait flags >>                                        01152000
  nowait = 0,   << awake's wait field for nowait >>                     01153000
  msgwaitcode = 4;  << wait for msg waitfield code >>                   01154000
                                                                        01155000
integer                                                                 01156000
  QM3 = Q -3,  << for addressing of the stack marker >>                 01157000
  QM2 = Q -2,                                                           01158000
  QM1 = Q -1,                                                           01159000
  QM0 = Q -0,                                                           01160000
  Xreg = QM3, << for addr of the stack marker >>                        01161000
  deltaP = QM2,                                                         01162000
  OldStatus = QM1,                                                      01163000
  deltaQ = QM0;                                                         01164000
                                                                        01165000
                                                                        01166000
comment: ===== port data segment structure =====                        01167000
;                                                                       01168000
                                                                        01169000
integer                                                                 01170000
  PortDSTnum            = DB + 0,         << DST index number      >>   01171000
  PortDSTsize           = DB + 1;         << segment size (words)  >>   01172000
integer pointer                                                         01173000
  UserRegionPointer     = DB + 2;         << may be used by others >>   01174000
integer                                                                 01175000
  PortDSTMaxSubqueue    = DB + 3,         << maximum subqueue num. >>   01176000
  PortDSTMaxMsgSize     = DB + 4,         << maximum mssg. size    >>   01177000
  PortDSTMaxContextSize = DB + 5;         << maximum context size  >>   01178000
integer pointer                                                         01179000
  MsgPoolHead           = DB + 6,         << free message pool     >>   01180000
  MsgPoolTail           = DB + 7;                                       01181000
integer                                                                 01182000
  PoolCnt               = DB + 8,         << number of free mssg's >>   01183000
  ProcHead              = DB + 9,         << impeded process queue >>   01184000
  ProcTail              = DB + 10,                                      01185000
  TimeHead              = DB + 11,        << data is a pointer     >>   01186000
  TimeTRLX              = DB + 12;                                      01187000
integer pointer                                                         01188000
  PortCBPoolHead        = DB + 13,                          <<00005>>   01189000
  PortCBPoolTail        = DB + 14,                          <<00005>>   01190000
  CtxPoolHead           = DB + 15,                          <<00005>>   01191000
  CtxPoolTail           = DB + 16;                          <<00005>>   01192000
integer                                                                 01193000
  PrimaryCount          = DB + 17,                          <<00006>>   01194000
  SecondaryCount        = DB + 18,                          <<00006>>   01195000
  PortDSTMaxPorts       = DB + 19,                          <<00007>>   01196000
  PortDSTNumPorts       = DB + 20,                          <<00019>>   01197000
  PortDSTUserSize       = DB + 21;                          <<00019>>   01198000
double                                                                  01199000
  last'start'time       = DB + 22;                          <<00024>>   01200000
                                                                        01201000
<< Port Control Block structure (offset in second word of PortId)  >>   01202000
define                                                                  01203000
  PortCB'flags   = PortCB#,                                             01204000
  PortCB'mask    = PortCB(1)#,                                          01205000
  PortCB'pin     = PortCB(2)#,                                          01206000
  PortCB'context = PortCB(3)#,                                          01207000
  SemaphoreCnt   = IntPortCB(3)#,                                       01208000
  PortCB'type    = PortCB(4)#,                                          01209000
  PortCB'subtype = PortCB(4).(0:4)#,                                    01210000
  PortCB'OffICS  = PortCB(4).(9:1)#,                        <<00030>>   01211000
  PortCB'delete  = PortCB(4).(10:1)#,                                   01212000
  PortCB'active  = PortCB(4).(11:1)#,                                   01213000
  PortCB'enabled = PortCB(4).(12:1)#,                                   01214000
  PortCB'free    = PortCB(4).(13:1)#,                       <<00019>>   01215000
  pdisabled      = (15:1)#,               << PortCB(4).(15:1)      >>   01216000
  DB'PortDST     = (14:1)#,               << PortCB(4).(14:1)      >>   01217000
  PortCB'server'plabel = PortCB(5)#;                                    01218000
                                                                        01219000
<< Port types >>                                                        01220000
equate normal'subtype = 0,                                              01221000
       Semaphore'subtype = 1,                                           01222000
       IOWait'subtype = 2;                                              01223000
                                                                        01224000
<< IOWait Ports use a reserved region of the context area >>            01225000
<<   for maintaining the AFT, SoftInt, and PortProc info. >>            01226000
define IOWait'count = Context#,                                         01227000
       IOWait'aftindex = Context(1)#,                                   01228000
       IOWait'portplabel = Context(2)#,                                 01229000
       IOWait'softint'plabel = Context(3)#,                             01230000
       IOWait'aftioqx = Context(4)#;                                    01231000
                                                                        01232000
equate IOWait'usercontext = 5; << offset to user's part of context >>   01233000
                                                                        01234000
<< Signal Ports use a 3 word context area >>                            01235000
define homeport       = dblcontext(0)#,                                 01236000
       homesubqueue   = context(2)#;                                    01237000
                                                                        01238000
<< Timer message structure >>                                           01239000
equate deltatime'index = 2;                                 <<00024>>   01240000
define TimerCB'length    = TimerCB(1)#,                                 01241000
       TimerCB'reqid     = TimerCB(2)#,                                 01242000
       TimerCB'subqueue  = TimerCB(3)#,                                 01243000
       TimerCB'deltatime = TimerCB'dbl(deltatime'index)#,   <<00024>>   01244000
       TimerCB'replyport = TimerCB'dbl(3)#;                             01245000
equate TimerPoppedLen = 3;  << length of timer msg after it pops >>     01246000
equate TimerLength = 8;  << length of timer entry msg frames >>         01247000
                                                                        01248000
define std'decl = integer PortDST = PortId;                             01249000
                  logical pointer PortCB = PortId +1;                   01250000
                  double pointer PortCB'dbl = PortCB;                   01251000
                  double array AbsAddresses(*) = Q;  << no space >>     01252000
                  double AbsPortDB = AbsAddresses;                      01253000
                  integer AbsDB = AbsPortDB +1;                         01254000
                  double CallersDB = AbsAddresses + 2;                  01255000
                  double AbsMessage = AbsAddresses + 4#,                01256000
      std'decl2 = double dbl'ptrs;                                      01257000
                  integer pointer qhead = dbl'ptrs,                     01258000
                                  qtail = dbl'ptrs +1#;                 01259000
$page                                                                   01260000
                                                                        01261000
DEFINE db'to'PortDST =                                                  01262000
  disable;                                                              01263000
  pdisable;                                                             01264000
  x := PORTDST & LSL(2);                                                01265000
  tos := dst(x:=x+2); << bank >>                                        01266000
  tos := dst(x:=x+1); << addr >>                                        01267000
  asmb(ddup);                                                           01268000
  asmb(xchd)#;                                                          01269000
                                                                        01270000
define exchangedb'to'PortDST =                                          01271000
  begin                                                                 01272000
  turn'traps'off;                                                       01273000
  tos := %344;  << DST 71 >>  << +*+ >>                                 01274000
  tos := abs(abs(2))&lsl(2);  << +*+ >>                                 01275000
  x := PortDST&LSL(2);                                                  01276000
  if not (tos <= x <= tos) then suddendeath(wrongDST);  << +*+ >>       01277000
  disable;                                                              01278000
  tos := dst(x);                                                        01279000
  if < then                                                             01280000
    do begin  << absent >>                                              01281000
      del;                                                              01282000
$IF  X5=OFF                                                             01283000
      queueonsegment(PortDST.(2:14));                                   01284000
$IF  X5=ON                                                              01285000
      queueonsegment(double(PortDST.(2:14)));                           01286000
$IF                                                                     01287000
      tos := dst(x);                                                    01288000
    end until > ;                                                       01289000
  tos.(2:1) := true;  << set ref. bit >>                                01290000
  dst(x) := tos;                                                        01291000
  pdisable;                                                             01292000
  enable;                                                               01293000
                                                                        01294000
  tos := dst(x:=x+2);  << bank >>                                       01295000
  tos := dst(x:=x+1);  << addr >>                                       01296000
  asmb( ddup );                                                         01297000
  asmb( xchd );                                                         01298000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       01299000
  end#;  << Note that AbsPortDB and CallersDB is set/allocated here >>  01300000
                                                                        01301000
define exchangedb'back =                                                01302000
  begin                                                                 01303000
  asmb( xchd );                                                         01304000
  asmb( subs 4);  << Note: both AbsPortDB and CallersDB are popped >>   01305000
  penable;                                                              01306000
  end#;  << exchangedb'back >>                                          01307000
                                                                        01308000
<< CallersDB must be previously initialized >>                          01309000
define CalcAbsQ =  << push absolute bank and address onto tos >>        01310000
  begin                                                                 01311000
  push(Q,SBank);                                                        01312000
  tos := AbsDB;                                                         01313000
  asmb( cab,ladd );                                                     01314000
  end#;                                                                 01315000
                                                                        01316000
<< a move absolute requries five words on tos >>                        01317000
define mabs5 = << perform the move, and pop all parameters >>           01318000
  asmb( mabs 5 )#;                                                      01319000
                                                                        01320000
<< Check if executing on the ICS.  Done by checking if the >>           01321000
<< Q register is between the ICS limits of QI and ZI. >>                01322000
<< The tos is true if on the ICS, false otherwise. >>                   01323000
<< Also, if the pdisable count is greater than one, treat as >>         01324000
<< if on the ICS.  This assumes that the caller has one pdisable >>     01325000
<< in effect. >>                                                        01326000
                                                                        01327000
<< Interrupts must be disabled before this define is used >>            01328000
define on'ics =                                                         01329000
  begin                                                                 01330000
  if abs(abs(QI)-18) > 1 then tos := -1  << check pdisable count >>     01331000
  else                                                                  01332000
    begin                                                               01333000
    push(q,db,sbank);                                                   01334000
    asmb( cab,del );   << delete DB Bank >>                             01335000
    if tos <> 0 then asmb( ddel,zero )  << SBank <> 0 >>                01336000
    else                                                                01337000
      begin                                                             01338000
      asmb( ladd,stax );  << abs Q into X reg for CPRB >>               01339000
      tos := 5D;  << abs addr of QI,ZI >>                               01340000
      asmb( ldea );                                                     01341000
      asmb( dxch,ddel );  << delete 5D >>                               01342000
      if tos <= x <= tos                                                01343000
        then tos := -1                                                  01344000
        else tos := 0;                                                  01345000
      end;                                                              01346000
    end;                                                                01347000
  end#;                                                                 01348000
$page                                                                   01349000
<< Interrupts must be disabled before this define is used >>            01350000
define reset'message'bit =                                              01351000
  begin  << turn off the more messages flag >>                          01352000
  tos := PortCB'flags;                                                  01353000
  x := Subqueue;                                                        01354000
  asmb( trbc 0,x );                                                     01355000
  PortCB'flags := tos;                                                  01356000
  end#;  << reset'message'bit >>                                        01357000
                                                                        01358000
<< Interrupts must be disabled before this define is used >>            01359000
define set'message'bit =                                                01360000
  begin  << turn on the more messages flag >>                           01361000
  tos := PortCB'flags;                                                  01362000
  x := Subqueue;                                                        01363000
  asmb( tsbc 0,x );                                                     01364000
  PortCB'flags := tos;                                                  01365000
  end#;  << set'message'bit >>                                          01366000
                                                                        01367000
<< Interrupts must be disabled before this define is used >>            01368000
define dequeue'message =                                                01369000
  begin                                                                 01370000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   01371000
  @msg := @qhead;                                                       01372000
  @qhead := qhead;                                                      01373000
  if <> then PortCB'dbl(x) := dbl'ptrs                                  01374000
  else                                                                  01375000
    begin  << exausted a Subqueue >>                                    01376000
    PortCB'dbl(x) := 0D;                                                01377000
    reset'message'bit;  << turn off the more messages bit >>            01378000
    end;                                                                01379000
  end#;  << dequeue'message >>                                          01380000
                                                                        01381000
<< Interrupts must be disabled before this define is used >>            01382000
define dequeue'hipri'message =                                          01383000
  begin                                                                 01384000
  tos := PortCB'dbl;  << load both flags and mask >>                    01385000
  asmb( and );                                                          01386000
  if = then                                                             01387000
    begin   << no enabled subqueues with messages >>                    01388000
    @msg := tos;  << @msg := 0  because of = test above >>              01389000
    end                                                                 01390000
  else                                                                  01391000
    begin  << dequeue the highest priority Msg >>                       01392000
    asmb( scan );                                                       01393000
    asmb( del );                                                        01394000
    Subqueue := x;                                                      01395000
    dequeue'message;   << dequeue the message from the subqueue >>      01396000
    msg := Subqueue;                                                    01397000
    end;                                                                01398000
  end#;  << dequeue'hipri'message >>                                    01399000
define                                                                  01400000
  port'dispatcher'defs =                                    <<00044>>   01401000
    double  ctr'location;                                               01402000
    logical messages'pending;                               <<00044>>   01403000
    integer in'ctr, serve'ctr, temp'pin#,                   <<00044>>   01404000
                                                                        01405000
  calc'serve'loc =  << get serve'ctr location; save temp. ctr. >>       01406000
    tos := dst(MsgHarbTabDSTN & lsl(2) + 2); << bank >>                 01407000
    tos := dst(MsgHarbTabDSTN & lsl(2) + 3); << offset >>               01408000
    tos := tos + curpin * MsgHarbPortLength +                           01409000
                          MsgHarbHeaderSize + 3;                        01410000
    assemble(ddup); ctr'location := tos;                                01411000
    assemble(lsea); in'ctr := tos; assemble(ddel)#,                     01412000
                                                                        01413000
  reset'serve'ctr =       << clear the serve counter >>                 01414000
    if in'ctr = 0 then                                                  01415000
      begin                                                             01416000
        tos := ctr'location;                                            01417000
        assemble(ldi 0; ssea; ddel);                                    01418000
      end#,                                                             01419000
                                                                        01420000
  increment'serve'ctr =    << load, save, and increment serve'ctr >>    01421000
    tos := ctr'location;   << bank and address >>                       01422000
    assemble(lsea; dup);                                    <<00044>>   01423000
    serve'ctr := tos;                                       <<00044>>   01424000
    assemble (inca; ssea; ddel)#,                           <<00044>>   01425000
                                                                        01426000
  service'exceeded =                                                    01427000
    serve'ctr > max'serve#,     << check if process' .gt. maximum >>    01428000
                                                                        01429000
  check'messages'pending =                                              01430000
    tos := PortCB'dbl;   << load msg pend and enable flags  >>          01431000
    assemble (and);      << AND them, leave result on TOS   >>          01432000
    messages'pending := (tos <> 0)#,                        <<00044>>   01433000
                                                                        01434000
  set'active'pin =                                                      01435000
    temp'pin := PortCB'pin;                                             01436000
    PortCB'pin := curpin#,                                              01437000
                                                                        01438000
  reset'active'pin =                                                    01439000
    PortCB'pin := temp'pin;                                             01440000
    temp'pin := 0#,                                                     01441000
                                                                        01442000
  bump'holder'process =                                                 01443000
    on'ics;                                                             01444000
    if not tos and PortCB'active and                                    01445000
       not PortCB'type.pdisabled then                                   01446000
         bumpqpri(PortCB'pin, curpin)#;                     <<00044>>   01447000
$page                                                                   01448000
<< Note that WaitForMsg preserves the interrupt disable state >>        01449000
<< below, and re-disabling interrupts is not necessary. >>              01450000
define allocate'message'frame =                                         01451000
  begin                                                                 01452000
  disable;                                                              01453000
  PoolCnt := PoolCnt -1;                                                01454000
  if < then                                                             01455000
    begin                                                               01456000
    on'ics;  << set tos if on ics, or pdisable > 1 >>                   01457000
    if not tos then                                                     01458000
      do begin  << Into Secondary pool and process is impedable >>      01459000
        PoolCnt := PoolCnt +1;                                          01460000
        WaitForMsg;   <<+*+ what about abs db's? >>                     01461000
        PoolCnt := PoolCnt -1;                                          01462000
      end until >=;                                                     01463000
    end;                                                                01464000
  @msg := @MsgPoolHead;     << get a message from the free pool >>      01465000
  if = then enable  << Pool empty >>                                    01466000
  else                                                                  01467000
    begin                                                               01468000
    << msg available, delink it from free pool >>                       01469000
    @MsgPoolHead := MsgPoolHead;                                        01470000
    if = then                                                           01471000
      @MsgPoolTail := 0;  << Pool now empty >>                          01472000
    enable;                                                             01473000
    end;                                                                01474000
  end#;                                                                 01475000
                                                                        01476000
define release'message'frame =                                          01477000
  begin                                                                 01478000
  msg := 0;                                                             01479000
  disable;                                                              01480000
  if @MsgPoolHead <> 0 then                                             01481000
    begin  << Pool not empty, queue to tail >>                          01482000
    @MsgPoolTail := MsgPoolTail := @msg;                                01483000
    end                                                                 01484000
  else                                                                  01485000
    begin  << Pool was empty, should never happen >>                    01486000
    @MsgPoolHead := @MsgPoolTail := @msg;                               01487000
    end;                                                                01488000
  PoolCnt := PoolCnt +1;                                                01489000
  if > and ProcHead <> 0 then AwakeForMsg;                              01490000
  enable;                                                               01491000
  end#;  << release'message'frame >>                                    01492000
define allocate'ctx'frame =                                 <<00005>>   01493000
  begin                                                     <<00007>>   01494000
  disable;                                                  <<00005>>   01495000
  @msg := @CtxPoolHead;                                     <<00005>>   01496000
  if <> then                                                <<00005>>   01497000
    begin                                                   <<00005>>   01498000
    @CtxPoolHead := CtxPoolHead;                            <<00005>>   01499000
    if = then @CtxPoolTail := 0;                            <<00005>>   01500000
    end;                                                    <<00005>>   01501000
  enable;                                                   <<00005>>   01502000
  end#;                                                     <<00007>>   01503000
                                                            <<00005>>   01504000
define release'ctx'frame =                                  <<00005>>   01505000
  begin                                                     <<00007>>   01506000
  msg := 0;                                                 <<00005>>   01507000
  disable;                                                  <<00005>>   01508000
  if @CtxPoolHead <> 0 then                                 <<00005>>   01509000
    begin << Pool not empty, queue to tail >>               <<00005>>   01510000
    @CtxPoolTail := CtxPoolTail := @msg;                    <<00005>>   01511000
    end                                                     <<00005>>   01512000
  else                                                      <<00005>>   01513000
    begin << Pool was empty >>                              <<00005>>   01514000
    @CtxPoolHead := @CtxPoolTail := @msg;                   <<00005>>   01515000
    end;                                                    <<00005>>   01516000
  enable;                                                   <<00005>>   01517000
  end#;                                                     <<00007>>   01518000
                                                            <<00005>>   01519000
define allocate'portCB'frame =                              <<00005>>   01520000
  begin                                                     <<00007>>   01521000
  disable;                                                  <<00005>>   01522000
  @msg := @PortCBPoolHead;                                  <<00005>>   01523000
  if <> then                                                <<00005>>   01524000
    begin                                                   <<00005>>   01525000
    @PortCBPoolHead := PortCBPoolHead;                      <<00005>>   01526000
    if = then @PortCBPoolTail := 0;                         <<00005>>   01527000
    end;                                                    <<00005>>   01528000
  enable;                                                   <<00005>>   01529000
  end#;                                                     <<00007>>   01530000
                                                            <<00005>>   01531000
define release'portCB'frame =                               <<00005>>   01532000
  begin                                                     <<00007>>   01533000
  msg := 0;                                                 <<00005>>   01534000
  msg(4).(13:1) := true;   << set free bit >>               <<00044>>   01535000
  disable;                                                  <<00005>>   01536000
  if @PortCBPoolHead <> 0 then                              <<00005>>   01537000
    begin << Pool not empty, queue to tail >>               <<00005>>   01538000
    @PortCBPoolTail := PortCBPoolTail := @msg;              <<00005>>   01539000
    end                                                     <<00005>>   01540000
  else                                                      <<00005>>   01541000
    begin << Pool was empty >>                              <<00005>>   01542000
    @PortCBPoolHead := @PortCBPoolTail := @msg;             <<00005>>   01543000
    end;                                                    <<00005>>   01544000
  enable;                                                   <<00005>>   01545000
  end#;                                                     <<00007>>   01546000
                                                            <<00005>>   01547000
$page "external declarations"                                           01548000
procedure help;                                                         01549000
  option external;                                                      01550000
                                                                        01551000
procedure suddendeath(type);                                            01552000
  value type;                                                           01553000
  integer type;                                                         01554000
  option external;                                                      01555000
                                                                        01556000
procedure queueonsegment(segid);                                        01557000
  value segid;                                                          01558000
$IF X5=OFF                                                              01559000
  integer segid;                                                        01560000
$IF X5=ON                                                               01561000
  double segid;                                                         01562000
$IF                                                                     01563000
  option external;                                                      01564000
                                                                        01565000
integer procedure exchangedb(dstn);                                     01566000
  value dstn;                                                           01567000
  integer dstn;                                                         01568000
  option external;                                                      01569000
procedure resetdb(dbx);                                                 01570000
   value dbx; integer dbx;                                              01571000
   option privileged, external;                                         01572000
                                                                        01573000
integer procedure setsysdb;                                             01574000
   option privileged, external;                                         01575000
                                                                        01576000
procedure clearwws;                                                     01577000
  option external;                                                      01578000
                                                                        01579000
procedure awake(pcbpt,wakecode,waitflags);                              01580000
  value pcbpt,wakecode,waitflags;                                       01581000
  integer pcbpt;                                                        01582000
  logical wakecode,waitflags;                                           01583000
  option external;                                                      01584000
                                                                        01585000
procedure wait(eventmask,specialinfo);                                  01586000
  value eventmask,specialinfo;                                          01587000
  logical eventmask,specialinfo;                                        01588000
  option external;                                                      01589000
                                                                        01590000
procedure causesoftint(pin,type,subtype,plabel,msglen,flags);           01591000
  value pin,type,subtype,plabel,msglen,flags;                           01592000
  integer pin,type,subtype,plabel,msglen;                               01593000
  logical flags;                                                        01594000
  option external;                                                      01595000
                                                                        01596000
procedure loosesoftinterrupts;                              <<00003>>   01597000
  option  external;                                         <<00003>>   01598000
                                                                        01599000
procedure bumpqpri(holderpin,headpin);                                  01600000
  value holderpin,headpin;                                              01601000
  integer holderpin,headpin;                                            01602000
  option external;                                                      01603000
                                                                        01604000
procedure impede(pinx);                                                 01605000
  value pinx;                                                           01606000
  integer pinx;                                                         01607000
  option external;                                                      01608000
                                                                        01609000
procedure unimpede(pinx);                                               01610000
  value pinx;                                                           01611000
  integer pinx;                                                         01612000
  option external;                                                      01613000
                                                                        01614000
procedure impaired (proc, resource, flag);                              01615000
value               proc, resource, flag;                               01616000
integer             proc, resource;                                     01617000
logical                             flag;                               01618000
option external;                                                        01619000
                                                                        01620000
                                                                        01621000
integer procedure getdataseg(memsize,vdsize);                           01622000
  value memsize,vdsize;                                                 01623000
  integer memsize,vdsize;                                               01624000
  option external;                                                      01625000
                                                                        01626000
<< Same as "getdataseg", except the segment is initalized to zeros >>   01627000
integer procedure getdatasegc(memsize,vdsize);                          01628000
  value memsize,vdsize;                                                 01629000
  integer memsize,vdsize;                                               01630000
  option external;                                                      01631000
                                                                        01632000
integer procedure altdsegsize(dstindex,size);                           01633000
  value dstindex,size;                                                  01634000
  integer dstindex,size;                                                01635000
  option external;                                                      01636000
                                                                        01637000
procedure reldataseg(dstindex);                                         01638000
  value dstindex;                                                       01639000
  integer dstindex;                                                     01640000
  option external;                                                      01641000
                                                                        01642000
integer procedure Obtain(Res,AltRes);                                   01643000
  value AltRes;                                                         01644000
  integer Res,AltRes;                                                   01645000
  option external;                                                      01646000
                                                                        01647000
procedure Release(Res,AltRes,WakeUp);                                   01648000
  value AltRes,WakeUp;                                                  01649000
  logical WakeUp;                                                       01650000
  integer Res,AltRes;                                                   01651000
  option external;                                                      01652000
                                                                        01653000
integer procedure timereq(code,req,time);                               01654000
  value code,req,time;                                                  01655000
  integer code,req;                                                     01656000
  double time;                                                          01657000
  option external;                                                      01658000
                                                                        01659000
procedure aborttimereq(trlx);                                           01660000
  value trlx;                                                           01661000
  integer trlx;                                                         01662000
  option external;                                                      01663000
                                                                        01664000
double procedure timer;                                                 01665000
  option external;                                                      01666000
                                                                        01667000
                                                                        01668000
procedure iofreeze'(segident);                                          01669000
  value segident;                                                       01670000
$IF  X5=OFF                                                             01671000
  logical segident;                                                     01672000
$IF  X5=ON                                                              01673000
  double segident;                                                      01674000
$IF                                                                     01675000
  option external;                                                      01676000
                                                                        01677000
procedure iounfreeze'(segident);                                        01678000
  value segident;                                                       01679000
$IF  X5=OFF                                                             01680000
  logical segident;                                                     01681000
$IF  X5=ON                                                              01682000
  double segident;                                                      01683000
$IF                                                                     01684000
  option external;  << alternate entry point into iofreeze' >>          01685000
integer procedure DST'Size(DSTno);                                      01686000
  value                    DSTno;                                       01687000
  integer                  DSTno;                                       01688000
  option external;                                                      01689000
                                                                        01690000
integer procedure Wheres'DB;                                            01691000
  option external;                                                      01692000
                                                                        01693000
COMMENT                                                                 01694000
                                                                        01695000
IOFREEZE' IS CALLED FROM I/O SYSTEM MONITORS TO FREEZE' A               01696000
SEGMENT IN MEMORY SO THAT INSTRUCTION FETCH AND DATA                    01697000
TRANSFER BY DMA I/O SYSTEM DEVICES MAY TAKE PLACE.  IF                  01698000
THE REQUIRED SEGMENT IS PRESENT, THE SEGMENT GETS IO FROZEN             01699000
IF IT IS ABSENT, STATUS THROUGH THE CONDITION CODE IS RETURNED          01700000
AND NOTHING IS DONE.  THE MONITOR MUST MAKE A SPECIAL                   01701000
REQUEST FOR THE SEGMENT TO THE SCHEDULER, SINCE BLOCKING                01702000
THE MONITOR ON THE ICS IN IOFREEZE' WOULDN'T WORK.                      01703000
                                                                        01704000
;                                                                       01705000
                                                                        01706000
procedure fetchioseg(segid,ldev,ioreqsysbaseinx,flags);                 01707000
  value segid,ldev,ioreqsysbaseinx,flags;                               01708000
$IF  X5=OFF                                                             01709000
  logical segid,ldev,ioreqsysbaseinx,flags;                             01710000
$IF  X5=ON                                                              01711000
double  segid;                                                          01712000
logical ldev, ioreqsysbaseinx, flags;                                   01713000
$IF                                                                     01714000
  option external;                                                      01715000
                                                                        01716000
COMMENT                                                                 01717000
                                                                        01718000
FETCHIOSEG IS USED BY I/O SYSTEM MONITORS TO REQUEST SEGMENTS ON        01719000
BEHALF OF DEVICES.  THIS INTERFACE ALLOWS THE CALLER TO REQUEST         01720000
A DRIVER OR BUFFER DATA SEGMENT IN AN UNBLOCKED MANNER.  WHEN THE       01721000
SEGMENT ARRIVES, IT IS IOFROZEN IF THIS HAD BEEN REQUESTED, AND         01722000
AWAKEIO IS CALLED ON THE APPROPRIATE DEVICE. ALSO, THE DATA FROZEN      01723000
BIT IN THE SPECIFIED I/O REQUEST FLAGS WORD IS SET FOR DATA SEGMENT     01724000
REQUESTS, AND THE DRIVER FROZEN BIT IN THE ILT IS SET FOR DRIVER        01725000
FETCH REQUESTS.                                                         01726000
                                                                        01727000
PARAMETER SPECIFICATION :                                               01728000
                                                                        01729000
   SEGID : .(0:2) = SEG TYPE FIELD                                      01730000
                                                                        01731000
                  = 0 ==> DATA SEG ==> .(2:14) = DST NUMBER             01732000
                  = 1 ==> SL SEG   ==> .(2:14) = SL NUMBER              01733000
                  = 2 ==> PROG SEG ==> .(1:7) = CSTXBLK INDEX,          01734000
                                       .(8:8) = LOG SEG #               01735000
                                                                        01736000
   LDEV : LOGICAL DEVICE NUMBER OF DEVICE REQUIRING SEGMENT             01737000
                                                                        01738000
   IOREQSYSBASEINX : SYSBASE RELATIVE INDEX OF BASE OF I/O REQUEST      01739000
                     ELEMENT ASSOCIATED WITH THE SEGMENT FETCH REQUEST  01740000
                     (ONLY REQUIRED FOR DATA SEGMENT FETCH REQUESTS)    01741000
                                                                        01742000
   FLAGS : .(0:1) = 1 ==> IOFREEZE SEGMENT WHEN IT ARRIVES              01743000
                                                                        01744000
CONDITION CODE RETURN SPECIFICATION :                                   01745000
                                                                        01746000
   RETURN CC = CCE ==> SEGMENT IS PRESENT, AND HAS BEEN I/O FROZEN      01747000
                       IF SO REQUESTED (BUT DATA FROZEN, DRIVER FROZEN  01748000
                       BITS NOT SET, AWAKEIO NOT CALLED)                01749000
             = CCG ==> SEGMENT NOT AROUND, AND REQUEST FOR SEGMENT      01750000
                       HAS BEEN ISSUED.                                 01751000
;                                                                       01752000
$page "forward declarations"                                            01753000
<<$SPLINTR$  Used to automate the building of the SPLINTR file >>       01754000
                                                                        01755000
double procedure FindProcessPort(Pin);                                  01756000
  value Pin;                                                            01757000
  integer Pin;                                                          01758000
  option forward;                                                       01759000
                                                                        01760000
procedure Send'DB(PortId,Subqueue,Message);                             01761000
  value PortId,Subqueue,Message;                                        01762000
  double PortId;                                                        01763000
  integer Subqueue;                                                     01764000
  integer pointer Message;                                              01765000
  option forward;                                                       01766000
                                                                        01767000
procedure Send'Q(PortId,Subqueue,Message);                              01768000
  value PortId,Subqueue,Message;                                        01769000
  double PortId;                                                        01770000
  integer Subqueue;                                                     01771000
  integer pointer Message;  <<;';>>                                     01772000
<<integer Message;>> << Message is the caller's Qreg relative           01773000
                        address. >>                                     01774000
  option forward;                                                       01775000
                                                                        01776000
procedure Send'S(PortId,Subqueue,Message);                              01777000
  value PortId,Subqueue,Message;                                        01778000
  double PortId;                                                        01779000
  integer Subqueue;                                                     01780000
  integer pointer Message;  <<;';>>                                     01781000
<<integer Message;>> << Message refers to the size of the               01782000
                          array allocated on tos. >>                    01783000
  option forward;                                                       01784000
                                                                        01785000
procedure Send'Ref(PortId,Subqueue,Message);                            01786000
  value PortId,Subqueue,Message;                                        01787000
  double PortId;                                                        01788000
  integer Subqueue;                                                     01789000
  integer pointer Message;                                              01790000
  option forward;                                                       01791000
                                                                        01792000
procedure Receive'DB(PortId,Message,EnableMask);                        01793000
  value PortId,Message,EnableMask;                                      01794000
  double PortId;                                                        01795000
  integer pointer Message;                                              01796000
  logical EnableMask;                                                   01797000
  option forward;                                                       01798000
                                                                        01799000
procedure Receive'Q(PortId,Message,EnableMask);                         01800000
  value PortId,Message,EnableMask;                                      01801000
  double PortId;                                                        01802000
  integer pointer Message;  <<;';>>                                     01803000
<<integer Message;>> << Message is the caller's Qreg relative           01804000
                        address. >>                                     01805000
  logical EnableMask;                                                   01806000
  option forward;                                                       01807000
                                                                        01808000
procedure Receive'S(PortId,Message,EnableMask);                         01809000
  value PortId,Message,EnableMask;                                      01810000
  double PortId;                                                        01811000
  integer pointer Message;  <<;';>>                                     01812000
<<integer Message;>> << Message refers to the size of the               01813000
                          array allocated on tos. >>                    01814000
  logical EnableMask;                                                   01815000
  option forward;                                                       01816000
                                                                        01817000
integer procedure Receive'Ref(PortId,Dummy,EnableMask);                 01818000
  value PortId,Dummy,EnableMask;                                        01819000
  double PortId;                                                        01820000
  integer Dummy;                                                        01821000
  logical EnableMask;                                                   01822000
  option forward;                                                       01823000
                                                                        01824000
procedure ReceiveWait'DB(PortId,Message,EnableMask);                    01825000
  value PortId,Message,EnableMask;                                      01826000
  double PortId;                                                        01827000
  integer pointer Message;                                              01828000
  logical EnableMask;                                                   01829000
  option forward;                                                       01830000
                                                                        01831000
procedure ReceiveWait'Q(PortId,Message,EnableMask);                     01832000
  value PortId,Message,EnableMask;                                      01833000
  double PortId;                                                        01834000
  integer pointer Message;  <<;';>>                                     01835000
<<integer Message;>> << Message is the caller's Qreg relative           01836000
                        address. >>                                     01837000
  logical EnableMask;                                                   01838000
  option forward;                                                       01839000
                                                                        01840000
procedure ReceiveWait'S(PortId,Message,EnableMask);                     01841000
  value PortId,Message,EnableMask;                                      01842000
  double PortId;                                                        01843000
  integer pointer Message;  <<;';>>                                     01844000
<<integer Message;>> << Message refers to the size of the               01845000
                          array allocated on tos. >>                    01846000
  logical EnableMask;                                                   01847000
  option forward;                                                       01848000
                                                                        01849000
procedure Replace'DB(PortId,Subqueue,Message);                          01850000
  value PortId,Subqueue,Message;                                        01851000
  double PortId;                                                        01852000
  integer Subqueue;                                                     01853000
  integer pointer Message;                                              01854000
  option forward;                                                       01855000
                                                                        01856000
procedure Replace'Q(PortId,Subqueue,Message);                           01857000
  value PortId,Subqueue,Message;                                        01858000
  double PortId;                                                        01859000
  integer Subqueue;                                                     01860000
  integer pointer Message;  <<;';>>                                     01861000
<<integer Message;>> << Message is the caller's Qreg relative           01862000
                        address. >>                                     01863000
  option forward;                                                       01864000
                                                                        01865000
procedure Replace'S(PortId,Subqueue,Message);                           01866000
  value PortId,Subqueue,Message;                                        01867000
  double PortId;                                                        01868000
  integer Subqueue;                                                     01869000
  integer pointer Message;  <<;';>>                                     01870000
<<integer Message;>> << Message refers to the size of the               01871000
                          array allocated on tos. >>                    01872000
  option forward;                                                       01873000
                                                                        01874000
procedure Replace'Ref(PortId,Subqueue,Message);                         01875000
  value PortId,Subqueue,Message;                                        01876000
  double PortId;                                                        01877000
  integer Subqueue;                                                     01878000
  integer pointer Message;                                              01879000
  option forward;                                                       01880000
                                                                        01881000
procedure Discard'Ref(PortId,Message);                                  01882000
  value PortId,Message;                                                 01883000
  double PortId;                                                        01884000
  integer pointer Message;                                              01885000
  option forward;                                                       01886000
                                                                        01887000
integer procedure GetMessage'Ref(PortId);                               01888000
  value PortId;                                                         01889000
  double PortId;                                                        01890000
  option forward;                                                       01891000
                                                                        01892000
procedure PortMaskDisable(PortId,DisableMask);                          01893000
  value PortId,DisableMask;                                             01894000
  double PortId;                                                        01895000
  logical DisableMask;                                                  01896000
  option forward;                                                       01897000
                                                                        01898000
procedure PortMaskEnable(PortId,EnableMask);                            01899000
  value PortId,EnableMask;                                              01900000
  double PortId;                                                        01901000
  logical EnableMask;                                                   01902000
  option forward;                                                       01903000
                                                                        01904000
logical procedure PortDisable(PortId);                                  01905000
  value PortId;                                                         01906000
  double PortId;                                                        01907000
  option forward;                                                       01908000
                                                                        01909000
logical procedure PortEnable(PortId);                                   01910000
  value PortId;                                                         01911000
  double PortId;                                                        01912000
  option forward;                                                       01913000
                                                                        01914000
integer procedure NewPortStatus(PortId,Type);                           01915000
  value PortId,Type;                                                    01916000
  double PortId;                                                        01917000
  integer Type;                                                         01918000
  option forward;                                                       01919000
                                                                        01920000
double procedure CreatePort(ClassName,PortDST,NewFrames);               01921000
  value PortDST,NewFrames;                                              01922000
  byte array ClassName;                                                 01923000
  integer PortDST,NewFrames;                                            01924000
  option forward;                                                       01925000
                                                                        01926000
procedure CreatePort'(PortDST, Type, Plabel, NumSubqueues, ContextSize, 01927000
                      PortId,  Result);                                 01928000
  value               PortDST, Type, Plabel, NumSubqueues, ContextSize; 01929000
  integer     Result, PortDST, Type, Plabel, NumSubqueues, ContextSize; 01930000
  double              PortId;                                           01931000
  option forward;                                                       01932000
procedure TerminatePort(PortId);                                        01933000
  value PortId;                                                         01934000
  double PortId;                                                        01935000
  option forward;                                                       01936000
                                                                        01937000
procedure DeletePort(PortId);                                           01938000
  value PortId;                                                         01939000
  double PortId;                                                        01940000
  option forward;                                                       01941000
                                                                        01942000
procedure AddPortClassName(ClassName,Plabel,Type,SubType,               01943000
                                ContextSize,MsgSize,NumSubqueues);      01944000
  value Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;           01945000
  byte array ClassName;                                                 01946000
  integer Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;         01947000
  option forward;                                                       01948000
                                                                        01949000
procedure DeletePortClassName(ClassName);                               01950000
  byte array ClassName;                                                 01951000
  option forward;                                                       01952000
                                                                        01953000
integer procedure InitPortDST(PortDST,MaxSubqueues,                     01954000
                                NumMessages,MaxMsgSize,                 01955000
                                MaxContextSize,                         01956000
                                UserReservedRegionSize);                01957000
  value   PortDST,MaxSubqueues,                                         01958000
            NumMessages,MaxMsgSize,                                     01959000
            MaxContextSize,                                             01960000
            UserReservedRegionSize;                                     01961000
  integer PortDST,MaxSubqueues,                                         01962000
            NumMessages,MaxMsgSize,                                     01963000
            MaxContextSize,                                             01964000
            UserReservedRegionSize;                                     01965000
  option forward;                                                       01966000
                                                                        01967000
procedure InitPortDST'(PrimaryPool, SecondaryPool, MaxMsgSize,          01968000
                       MaxPorts, MaxSubqueues, MaxContextSize,          01969000
                       UserRegSize, UserRegOffset, PortDST);            01970000
                                                                        01971000
  value                PrimaryPool, SecondaryPool, MaxMsgSize,          01972000
                       MaxPorts, MaxSubqueues, MaxContextSize,          01973000
                       UserRegSize;                                     01974000
                                                                        01975000
  integer              PrimaryPool, SecondaryPool, MaxMsgSize,          01976000
                       MaxPorts, MaxSubqueues, MaxContextSize,          01977000
                       UserRegSize, PortDST;                            01978000
integer pointer UserRegOffset;    option forward;                       01979000
procedure UpSemaphore(SemaphoreId);                                     01980000
  value SemaphoreId;                                                    01981000
  double SemaphoreId;                                                   01982000
  option forward;                                                       01983000
                                                                        01984000
procedure DownSemaphore'DB(SemaphoreId,Subqueue,Message);               01985000
  value SemaphoreId,Subqueue,Message;                                   01986000
  double SemaphoreId;                                                   01987000
  integer Subqueue;                                                     01988000
  integer pointer Message;                                              01989000
  option forward;                                                       01990000
                                                                        01991000
procedure DownSemaphore'Q(SemaphoreId,Subqueue,Message);                01992000
  value SemaphoreId,Subqueue,Message;                                   01993000
  double SemaphoreId;                                                   01994000
  integer Subqueue;                                                     01995000
  integer pointer Message;  <<;';>>                                     01996000
<<integer Message;>> << Message is the caller's Qreg relative           01997000
                        address. >>                                     01998000
  option forward;                                                       01999000
                                                                        02000000
procedure DownSemaphore'S(SemaphoreId,Subqueue,Message);                02001000
  value SemaphoreId,Subqueue,Message;                                   02002000
  double SemaphoreId;                                                   02003000
  integer Subqueue;                                                     02004000
  integer pointer Message;  <<;';>>                                     02005000
<<integer Message;>> << Message refers to the size of the               02006000
                          array allocated on tos. >>                    02007000
  option forward;                                                       02008000
                                                                        02009000
procedure DownSemaphore'Ref(SemaphoreId,Subqueue,Message);              02010000
  value SemaphoreId,Subqueue,Message;                                   02011000
  double SemaphoreId;                                                   02012000
  integer Subqueue;                                                     02013000
  integer pointer Message;                                              02014000
  option forward;                                                       02015000
                                                                        02016000
procedure Create'Semaphore'Port(PortDST, InitCount,                     02017000
                                PortId,  Result);                       02018000
  value                         PortDST, InitCount;                     02019000
  integer                       PortDST, InitCount, Result;             02020000
  double                        PortId;                                 02021000
  option forward;                                                       02022000
                                                                        02023000
procedure FetchSeg(SegId,ReqType,ReplyPort,                             02024000
                     ReplySubqueue);                                    02025000
  value SegId,ReqType,ReplyPort,ReplySubqueue;                          02026000
  logical SegId,ReqType;                                                02027000
  double ReplyPort;                                                     02028000
  integer ReplySubqueue;                                                02029000
  option forward;                                                       02030000
                                                                        02031000
procedure ReleaseSeg(SegId,ReqType);                                    02032000
  value SegId,ReqType;                                                  02033000
  logical SegId,ReqType;                                                02034000
  option forward;                                                       02035000
                                                                        02036000
double procedure StartTimer(DeltaTime,ReplyPort,ReplySubqueue,          02037000
                              ReqId);                                   02038000
  value DeltaTime,ReplyPort,ReplySubqueue,ReqId;                        02039000
  double DeltaTime,ReplyPort;                                           02040000
  integer ReplySubqueue,ReqId;                                          02041000
  option forward;                                                       02042000
                                                                        02043000
procedure AbortTimer(TimerId);                                          02044000
  value TimerId;                                                        02045000
  double TimerId;                                                       02046000
  option forward;                                                       02047000
                                                                        02048000
procedure Create'Signal'Port( PortDST, DestPortId,                      02049000
                              DestSubqueue, PortId, Result);            02050000
  value    PortDST, DestPortId, DestSubqueue;                           02051000
  integer  PortDST, DestSubqueue, Result;                               02052000
  double   DestPortId, PortId;                                          02053000
                                                                        02054000
  option forward;                                                       02055000
                                                                        02056000
double procedure CreateIOWaitPort(ClassName,PortDST,NewFrames);         02057000
  value ClassName,PortDST,NewFrames;                                    02058000
  byte pointer ClassName;                                               02059000
  integer PortDST,NewFrames;                                            02060000
  option forward;                                                       02061000
                                                                        02062000
procedure Create'IOWaitPort(PortDST, Plabel, NumSubques, ContextSize,   02063000
                            PortId,  Result);                           02064000
  value                     PortDST, Plabel, NumSubques, ContextSize;   02065000
  integer          Result,  PortDST, Plabel, NumSubques, ContextSize;   02066000
  double                    PortId;                                     02067000
  option forward;                                                       02068000
                                                                        02069000
integer procedure ChangeIOWaitPort(PortId,AFTindex,Pin,Plabel);         02070000
  value PortId,AFTindex,Pin,Plabel;                                     02071000
  double PortId;                                                        02072000
  integer AFTindex,Pin,Plabel;                                          02073000
  option forward;                                                       02074000
                                                                        02075000
integer procedure IncrementIOCount(PortId);                             02076000
  value PortId;                                                         02077000
  double PortId;                                                        02078000
  option forward;                                                       02079000
                                                                        02080000
integer procedure CheckIOCount(PortId);                                 02081000
  value PortId;                                                         02082000
  double PortId;                                                        02083000
  option forward;                                                       02084000
                                                                        02085000
procedure DictAdd(Name,Data,Result);                                    02086000
  integer array Name,Data;                                              02087000
  integer Result;                                                       02088000
  option forward;                                                       02089000
                                                                        02090000
procedure DictDelete(Name,Dummy,Result);                                02091000
  integer array Name,Dummy;                                             02092000
  integer Result;                                                       02093000
  option forward;                                                       02094000
                                                                        02095000
procedure DictFind(Name,Data,Result);                                   02096000
  integer array Name,Data;                                              02097000
  integer Result;                                                       02098000
  option forward;                                                       02099000
                                                                        02100000
procedure DictUpdate(Name,Data,Result);                                 02101000
  integer array Name,Data;                                              02102000
  integer Result;                                                       02103000
  option forward;                                                       02104000
                                                                        02105000
procedure DictSend(Name,Data,Result);                                   02106000
  integer array Name,Data;                                              02107000
  integer Result;                                                       02108000
  option forward;                                                       02109000
                                                                        02110000
<<$SPLINTR$>>                                                           02111000
$page "forward declarations - not in SPLINTR file"                      02112000
<< forward decl's that are NOT to be included in the SPLINTR file >>    02113000
                                                                        02114000
procedure WaitForMsg;                                                   02115000
  option forward;                                                       02116000
                                                                        02117000
procedure AwakeForMsg;                                                  02118000
  option forward;                                                       02119000
                                                                        02120000
procedure PortDispatcher(PortId);                                       02121000
  value PortId;                                                         02122000
  double PortId;                                                        02123000
  option forward;                                                       02124000
                                                                        02125000
procedure SysPortServer;                                                02126000
  option forward;  << NOT internal, but NOT in SPLINTR >>               02127000
                                                                        02128000
procedure ReceiveWait'server(PortId,Context,Message);                   02129000
  value PortId,Context,Message;                                         02130000
  double PortId;                                                        02131000
  integer pointer Context,Message;                                      02132000
  option forward;  << NOT internal, but NOT in SPLINTR >>               02133000
                                                                        02134000
                                                                        02135000
procedure GenerateDictname(ClassName,DictName);                         02136000
  byte array ClassName;                                                 02137000
  array DictName;                                                       02138000
  option forward;                                                       02139000
                                                                        02140000
procedure PortSeg'completor(msg'id);                                    02141000
  value msg'id;                                                         02142000
  integer msg'id;                                                       02143000
  option forward;                                                       02144000
                                                                        02145000
procedure PortTimeOut(TimerDST);                                        02146000
  value TimerDST;                                                       02147000
  integer TimerDST;                                                     02148000
  option forward;                                                       02149000
                                                                        02150000
procedure SignalPort'server(PortId,Context,Message);                    02151000
  value PortId,Context,Message;                                         02152000
  double PortId;                                                        02153000
  integer pointer Context,Message;                                      02154000
  option forward;                                                       02155000
                                                                        02156000
procedure EnableIOWaitPort(IOWait'Index);                               02157000
  value IOWait'Index;                                                   02158000
  integer IOWait'Index;                                                 02159000
  option forward;  << NOT internal, but NOT in SPLINTR >>               02160000
                                                                        02161000
procedure DisableIOWaitPort(IOWait'Index);                              02162000
  value IOWait'Index;                                                   02163000
  integer IOWait'Index;                                                 02164000
  option forward;  << NOT internal, but NOT in SPLINTR >>               02165000
                                                                        02166000
procedure IOWaitDispatcher(IOWait'Index);                               02167000
  value IOWait'Index;                                                   02168000
  integer IOWait'Index;                                                 02169000
  option forward;  << NOT internal, but NOT in SPLINTR >>               02170000
                                                                        02171000
integer procedure Allocate'IOWait'index(PortId);                        02172000
  value PortId;                                                         02173000
  double PortId;                                                        02174000
  option forward;                                                       02175000
                                                                        02176000
procedure Release'IOWait'index(Index);                                  02177000
  value Index;                                                          02178000
  integer Index;                                                        02179000
  option forward;                                                       02180000
                                                                        02181000
procedure IOWaitPort'server(PortId,Context,Message);                    02182000
  value PortId,Context,Message;                                         02183000
  double PortId;                                                        02184000
  integer pointer Context,Message;                                      02185000
  option forward;                                                       02186000
                                                                        02187000
<< =============================================================== >>   02188000
$page "Ports Facility Procedures"                                       02189000
                                                                        02190000
$control segment = port                                                 02191000
                                                                        02192000
procedure IPCVersion(Version);                                          02193000
byte array           Version;                                           02194000
begin                                                                   02195000
  move Version := port'versionid;                                       02196000
end;                                                                    02197000
                                                                        02198000
logical procedure badDST(DSTno);                                        02199000
  value                  DSTno;                                         02200000
  integer                DSTno;                                         02201000
  option internal;                                                      02202000
  begin                                                                 02203000
    badDST := (DSTno < %70) LOR (DSTno >= INTEGER(DST(0))) LOR          02204000
              (INTEGER(DST(DSTno&LSL(2))) = %100000);                   02205000
  end;                                                                  02206000
$page "Wait/Awake for Msg"                                              02207000
procedure WaitForMsg;                                                   02208000
  option privileged,uncallable,internal; begin                          02209000
comment  This procedure is called with both interrupts disabled         02210000
    and process switching disabled.  The global define                  02211000
    "allocate'message'frame" is the usual caller, and will              02212000
    determine if we are executing in an environment that allows         02213000
    us to wait the process.  (e.g., not on the ICS and the              02214000
    pdisable counter was zero when the user called this code).          02215000
    **Note: Expects abs PortDST & Caller's DST as arguments by ref      02216000
  ;                                                                     02217000
  logical Pin;                                                          02218000
  integer PortDST;                                                      02219000
  double array AbsAddresses(*) = Q-7, AbsNewAddr(*) = Q;                02220000
  double AbsPortDB    = AbsAddresses,                                   02221000
         CallersDB    = AbsAddresses + 2,                               02222000
         AbsPortNewDB = AbsNewAddr,                                     02223000
         CallersNewDB = AbsNewAddr + 2;                                 02224000
                                                                        02225000
  PortDST := PortDSTnum;                                                02226000
  Pin := curpin;                                                        02227000
  if ProcHead = 0 then                                                  02228000
    begin  << first process to wait >>                                  02229000
    ProcHead := ProcTail := Pin;                                        02230000
    end                                                                 02231000
  else                                                                  02232000
    begin  << not first process, queue to tail >>                       02233000
$IF  X5=OFF                                                             02234000
    pcb(ProcTail * pcbsize + pcb'iqptr).iqptr := Pin;                   02235000
$IF  X5=ON                                                              02236000
    pcb(ProcTail * pcbsize + pcb'iqptr) := abs(cpcb);                   02237000
$IF                                                                     02238000
    ProcTail := Pin;                                                    02239000
    end;                                                                02240000
                                                                        02241000
  << make the new queuer's iqptr zero.  (should be zero already) >>     02242000
$IF  X5=OFF                                                             02243000
    pcb(pin*pcbsize+pcb'iqptr).iqptr := 0;                              02244000
$IF  X5=ON                                                              02245000
    pcb(pin*pcbsize+pcb'iqptr) := 0;                                    02246000
$IF                                                                     02247000
  bumpqpri(Pin,ProcHead);   << duplicate "impaired" >>                  02248000
  impede(0);                                                            02249000
  exchangedb'to'PortDST;  << restore original environment >>            02250000
  disable;                                                              02251000
  AbsPortDB := AbsPortNewDB;                                            02252000
  CallersDB := CallersNewDB;                                            02253000
                                                                        02254000
  end;                                                                  02255000
procedure AwakeForMsg;                                                  02256000
  option privileged,uncallable,internal; begin                          02257000
comment  This procedure is called with both interrupts disabled         02258000
    and process switching disabled.  The global define                  02259000
    "release'message'frame" is the usual caller.                        02260000
  ;                                                                     02261000
                                                                        02262000
  integer pcb'index,                                                    02263000
          nextpin;                                                      02264000
                                                                        02265000
  pcb'index := ProcHead*pcbsize;                                        02266000
$IF  X5=OFF                                                             02267000
  nextpin := pcb(pcb'index + pcb'iqptr).iqptr;                          02268000
$IF  X5=ON                                                              02269000
  nextpin := pcb(pcb'index + pcb'iqptr)/pcbsize;                        02270000
$IF                                                                     02271000
  if =                                                                  02272000
    then ProcHead := Proctail := 0  << only one process waiting >>      02273000
    else ProcHead := nextpin;  << new head process >>                   02274000
$IF  X5=OFF                                                             02275000
  pcb(pcb'index + pcb'iqptr).iqptr := 0;                                02276000
$IF  X5=ON                                                              02277000
  pcb(pcb'index + pcb'iqptr) := 0;                                      02278000
$IF                                                                     02279000
                                                                        02280000
  unimpede(pcb'index);                                                  02281000
  end;                                                                  02282000
$page "PortDispatcher"                                                  02283000
                                                                        02284000
procedure PortDispatcher(PortId);                                       02285000
  value PortId;                                                         02286000
  double PortId;                                                        02287000
  option privileged,uncallable,internal;                                02288000
  begin                                                                 02289000
<< Note: This procedure is called with interrupts disabled >>           02290000
<<       and does an exchangedb'back on behalf of the caller. >>        02291000
                                                                        02292000
  logical delete'port;                                      <<00020>>   02293000
  integer pointer Message,                                              02294000
                  msg;                                                  02295000
  integer Subqueue;                                                     02296000
  integer Old'DST,                                                      02297000
          max'msg'size,                                                 02298000
          context'ptr,                                                  02299000
          context'size,                                                 02300000
          T'PortCB'plabel;                                              02301000
integer SysPin;                                             <<00030>>   02302000
  integer pointer T'PortCB'context;                                     02303000
  integer S0 = S-0;                                                     02304000
                                                                        02305000
  double AbsPortDB' = Q-9,   << caller has stacked Abs addr. >>         02306000
         CallersDB' = Q-7;                                              02307000
  port'dispatcher'defs;                                     <<00044>>   02308000
                                                                        02309000
                                                                        02310000
  std'decl2;   << qhead/qtail >>                                        02311000
  std'decl;                                                             02312000
                                                                        02313000
    calc'serve'loc;                                         <<00044>>   02314000
                                                                        02315000
  tos := AbsPortDB';  << pretend exchangedb'to'portdst was called >>    02316000
  tos := CallersDB';                                                    02317000
                                                                        02318000
  if PortCB'type.pdisabled then                                         02319000
    begin   << callable in any enviorment, including ICS >>             02320000
    << This code is duplicated in Send, PortEnable, and >>              02321000
    << PortMaskEnable primitives for performance reasons. >>            02322000
    << Therefore, it should never be called here. >>                    02323000
                                                                        02324000
    << run the server procedure >>                                      02325000
    PortCB'active := true;  << mutual exclusion semaphore >>            02326000
    dequeue'hipri'message;                                              02327000
    do begin                                                            02328000
      enable;                                                           02329000
      << actually run the server here >>                                02330000
      tos := PortId;                                                    02331000
      tos := PortCB'context;                                            02332000
      tos := @msg;                                                      02333000
      tos := PortCB'server'plabel;                                      02334000
      asmb( pcal 0 );                                                   02335000
                                                                        02336000
      << check for more messages >>                                     02337000
      disable;                                                          02338000
      if PortCB'enabled and not PortCB'delete                           02339000
        then dequeue'hipri'message                                      02340000
        else @msg := 0;                                                 02341000
    end until @msg = 0;                                                 02342000
                                                                        02343000
    PortCB'active := false;  << mutual exclusion no longer needed >>    02344000
    enable;                                                             02345000
    if PortCB'delete then                                               02346000
      begin                                                             02347000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             02348000
      DeletePort(PortId);                                               02349000
      end                                                               02350000
    else exchangedb'back;  << CallersDB/AbsPortDB is popped >>          02351000
    return;  << exit PortDispatcher >>                                  02352000
    end   << ICS-Port >>                                                02353000
  else                                                                  02354000
    begin   << callable in a penabled state >>                          02355000
    on'ics;  << tos = true if executing on the ics >>                   02356000
$IF  X5=OFF                                                             02357000
    if tos or abs(abs(cpcb) +2) < 0 then                                02358000
$IF  X5=ON                                                              02359000
    if tos or pcb(abs(cpcb) +2) < 0 then                                02360000
$IF                                                                     02361000
      begin << on the ICS, called pdisabled, or DB at SYSDB >>          02362000
      PortCB'enabled := false;                              <<00031>>   02363000
      Syspin := if PortCB'offICS then PortCB'pin            <<00044>>   02364000
                                 else SysPort'pin;                      02365000
      enable;                                                           02366000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             02367000
      tos := 3;   << Blocked I/O Subqueue, ignored >>                   02368000
      tos := 4;   << Length >>                                          02369000
      tos := PortId;                                                    02370000
      Send'S(FindProcessPort(Syspin),4,4);                  <<00030>>   02371000
      return;   << exit from PortDispatcher >>                          02372000
      end;                                                              02373000
    PortCB'active := true;  << mutual exclusion semaphore >>            02374000
    set'active'pin;                                         <<00044>>   02375000
    dequeue'hipri'message;                                              02376000
    enable;                                                             02377000
    if PortCB'type.DB'PortDST then                                      02378000
      begin  << callable with DB @ PortDST >>                           02379000
      << Simulate an "exchangedb'back" and an "exchangedb(PortDST)" >>  02380000
      asmb( subs 4 );  << CallersDB/AbsPortDB are popped >>             02381000
    x := to'xds;   << load index register with xds offset >>            02382000
    Old'DST := pcb'xds;                                                 02383000
    pcb'xds := PortDST;                                                 02384000
      penable;                                                          02385000
      do begin                                                          02386000
        enable;                                                         02387000
        << actually run the server here >>                              02388000
        tos := PortId;                                                  02389000
        tos := PortCB'context;                                          02390000
        tos := @msg;                                                    02391000
        tos := PortCB'server'plabel;                                    02392000
        asmb( pcal 0 );                                                 02393000
                                                                        02394000
        << check for more messages >>                                   02395000
        disable;                                                        02396000
                                                                        02397000
        check'messages'pending;                             <<00044>>   02398000
        increment'serve'ctr;                                            02399000
        if service'exceeded and messages'pending then                   02400000
          begin  << transfer to a port server >>                        02401000
            reset'serve'ctr;                                            02402000
            pdisable;                 << enter critical region >>       02403000
            PortCB'enabled := false;                                    02404000
            PortCB'active := false; reset'active'pin;                   02405000
            Syspin := if PortCB'offICS then PortCB'pin                  02406000
                                       else SysPort'Pin;                02407000
            penable;                                                    02408000
            enable;                   << exit  critical region >>       02409000
            if Old'DST <> PortDST then                                  02410000
              exchangedb(Old'DST);    << get back to old DB    >>       02411000
            tos := 3;                 << Subqueue is ignored   >>       02412000
            tos := 4;                 << Length                >>       02413000
            tos := PortId;            << service this port     >>       02414000
            Send'S(FindProcessPort(SysPin),4,4);                        02415000
            return;                   << exit PortDispatcher   >>       02416000
          end                                                           02417000
        else                                                <<00044>>   02418000
        if PortCB'enabled and not PortCB'delete                         02419000
          then dequeue'hipri'message                                    02420000
          else @msg := 0;                                               02421000
      end until @msg = 0;                                               02422000
                                                                        02423000
                                                                        02424000
      reset'serve'ctr;                                      <<00044>>   02425000
                                                                        02426000
      PortCB'active := false;  << mutual exclusion no longer needed >>  02427000
      reset'active'pin;                                     <<00044>>   02428000
      delete'port := PortCB'delete;                         <<00020>>   02429000
      enable;                                                           02430000
      if Old'DST <> PortDST then exchangedb(Old'DST);       <<00020>>   02431000
      if delete'port then                                   <<00020>>   02432000
        DeletePort(PortId);                                             02433000
      return;  << exit PortDispatcher >>                                02434000
      end   << penabled, DB @ PortDST port-type >>                      02435000
    else                                                                02436000
      begin   << callable in penabled state, DB @ StackDB >>            02437000
      max'msg'size := PortDSTMaxMsgSize;                                02438000
      context'ptr := PortCB'context;                                    02439000
      context'size := PortDSTMaxContextSize;                            02440000
      T'PortCB'plabel := PortCB'server'plabel;                          02441000
                                                                        02442000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             02443000
      Old'DST := exchangedb(0);                                         02444000
                                                                        02445000
      << make room for data structures on the stack >>                  02446000
      @Message := @S0 +1;                                               02447000
      tos := max'msg'size;                                              02448000
      asmb( adds 0 );  << allocate space for messages >>                02449000
                                                                        02450000
      if context'ptr = 0 then @T'PortCB'context := 0                    02451000
      else                                                              02452000
        begin   << copy the context area to the stack >>                02453000
        @T'PortCB'context := @S0 +1;                                    02454000
        tos := context'size;                                            02455000
        asmb( adds 0 );  << allocate space for context area >>          02456000
        tos := @T'PortCB'context;  << move context to stack >>          02457000
        tos := PortDST;                                                 02458000
        tos := context'ptr;                                             02459000
        tos := context'size;                                            02460000
        asmb( mfds 4 );                                                 02461000
        end;                                                            02462000
                                                                        02463000
      << simulate exchangedb'to'PortDST for first loop pass >>          02464000
      pdisable;                                                         02465000
      PUSH(DB);                                                         02466000
      asmb( ddup );                                                     02467000
                                                                        02468000
      do begin                                                          02469000
        enable;                                                         02470000
        exchangedb'back;                                                02471000
                                                                        02472000
        tos := @Message;   << copy message frame to stack >>            02473000
        tos := PortDST;                                                 02474000
        tos := @msg;                                                    02475000
        tos := max'msg'size;                                            02476000
        asmb( mfds 4 );                                                 02477000
                                                                        02478000
        << actually run the server here >>                              02479000
        tos := PortId;                                                  02480000
        tos := @T'PortCB'context;                                       02481000
        tos := @Message;                                                02482000
        tos := T'PortCB'plabel;                                         02483000
        asmb( pcal 0 );                                                 02484000
                                                                        02485000
        if context'ptr <> 0 then                                        02486000
          begin  << put a copy of the context back in the PortDST >>    02487000
          tos := PortDST;                                               02488000
          tos := context'ptr;                                           02489000
          tos := @T'PortCB'context;                                     02490000
          tos := context'size;                                          02491000
          asmb( mtds 4 );                                               02492000
          end;                                                          02493000
                                                                        02494000
        exchangedb'to'PortDST;                                          02495000
        release'message'frame;                                          02496000
                                                                        02497000
        << check for more messages >>                                   02498000
        disable;                                                        02499000
                                                                        02500000
        check'messages'pending;                             <<00044>>   02501000
        increment'serve'ctr;                                            02502000
        if service'exceeded and messages'pending then                   02503000
          begin  << transfer to a port server >>                        02504000
            reset'serve'ctr;                                            02505000
            pdisable;            << enter critical region   >>          02506000
            PortCB'enabled := false; PortCB'active := false;            02507000
            PortCB'active := false; reset'active'pin;                   02508000
            Syspin := if PortCB'offICS then PortCB'pin                  02509000
                                       else SysPort'pin;                02510000
            penable;                                                    02511000
            enable;              << exit  critical region   >>          02512000
            exchangedb'back;     << pop CallersDB/AbsPortDB >>          02513000
            tos := 3;            << Subqueue is ignored     >>          02514000
            tos := 4;            << Length                  >>          02515000
            tos := PortId;       << service this port       >>          02516000
            Send'S(FindProcessPort(SysPin),4,4);                        02517000
            return;              << exit PortDispatcher     >>          02518000
          end                                                           02519000
        else                                                <<00044>>   02520000
        if PortCB'enabled and not PortCB'delete                         02521000
          then dequeue'hipri'message                                    02522000
          else @msg := 0;                                               02523000
      end until @msg = 0;                                               02524000
                                                                        02525000
                                                                        02526000
      reset'serve'ctr;                                      <<00044>>   02527000
                                                                        02528000
      PortCB'active := false;  << mutual exclusion no longer needed >>  02529000
      reset'active'pin;                                     <<00044>>   02530000
      enable;                                                           02531000
      if PortCB'delete then                                             02532000
        begin                                                           02533000
        exchangedb'back;                                                02534000
        DeletePort(PortId);                                             02535000
        end                                                             02536000
      else exchangedb'back;                                             02537000
      if Old'DST <> 0 then exchangedb(Old'DST);                         02538000
      return;  << exit PortDispatcher >>                                02539000
      end;  << penabled, DB @ StackDB port-type >>                      02540000
                                                                        02541000
    end;   << callable penabled >>                                      02542000
  end;  << PortDispatcher >>                                            02543000
$page "Process Server Routines"                                         02544000
double procedure FindProcessPort(Pin);                                  02545000
  value Pin;                                                            02546000
  integer Pin;                                                          02547000
  option privileged,uncallable;                                         02548000
  begin                                                                 02549000
  integer PortDST = FindProcessPort,                                    02550000
          PortCB = PortDST +1;                                          02551000
                                                                        02552000
  if Pin = 0 then Pin := curpin;                                        02553000
  if Pin = -1 then Pin := 0;  << Dispatcher is Pin zero >>              02554000
                                                                        02555000
  PortDST := MsgHarbTabDSTN;                                            02556000
  PortCB := Pin * MsgHarbPortLength + MsgHarbHeaderSize;                02557000
  end;  << FindProcessPort >>                                           02558000
procedure SysPortServer;                                                02559000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 02560000
  begin                                                                 02561000
  << Note: this procedure is never called, but is procreated >>         02562000
  << as the outer block of a core resident process by initial. >>       02563000
                                                                        02564000
  double MyPortId,                                                      02565000
         SubqueueLength,  << first two words for 'receive' >>           02566000
         DelayedPortId;   << second two words for 'receive' >>          02567000
  integer Subqueue = Subqueuelength,                                    02568000
          Length = Subqueuelength +1,                                   02569000
          PortDST = DelayedPortId;                                      02570000
  integer msg'id = PortDST;                                             02571000
  integer pointer PortCB = DelayedPortId +1;                            02572000
                                                                        02573000
  MyPortId := FindProcessPort(0);                                       02574000
                                                                        02575000
  while true do  << do forever >>                                       02576000
    begin                                                               02577000
    ReceiveWait'S(MyPortId,4,-1);                                       02578000
    if not (0 <= Subqueue <= 4) then suddendeath(badport);  <<00016>>   02579000
    case *Subqueue of                                                   02580000
      begin                                                             02581000
<<0>> suddendeath(badport);                                             02582000
<<1>> PortSeg'completor(msg'id);                                        02583000
<<2>> PortTimeOut(PortDST);                                             02584000
<<3>> Suddendeath(badport);                                 <<00016>>   02585000
<<4>> PortEnable(DelayedPortId);                            <<00016>>   02586000
      end;                                                              02587000
    end;                                                                02588000
                                                                        02589000
  end;   << SysPortServer >>                                            02590000
$page "Send"                                                            02591000
                                                                        02592000
procedure Send'DB(PortId,Subqueue,Message);                             02593000
  value PortId,Subqueue,Message;                                        02594000
  double PortId;                                                        02595000
  integer Subqueue;                                                     02596000
  integer pointer Message;                                              02597000
  option privileged,uncallable;                                         02598000
                                                                        02599000
<< Note:  Message is really a Pascal type record.  The first >>         02600000
<<   word of message is the subqueue of the port to receive the >>      02601000
<<   message.  Note that subqueue is ignored by the Send >>             02602000
<<   primitives.  The second word is a positive word count of the >>    02603000
<<   message length, INCLUDING the two word header. >>                  02604000
  begin                                                                 02605000
comment  Algorithm:                                                     02606000
    Get a msg buffer from the free pool.                                02607000
    Move the caller's data into the msg buffer.                         02608000
    Queue the msg buffer to the port.                                   02609000
    If first msg in subqueue AND subqueue enabled AND                   02610000
       the port is enabled THEN  run the server procedure.              02611000
  ;                                                                     02612000
logical MsgMode;                                                        02613000
  entry Send'Q,   << secondary entry points >>                          02614000
        Send'S,                                                         02615000
        Send'Ref;                                                       02616000
                                                                        02617000
  integer array QM0array(*) = Q-0;                                      02618000
                                                                        02619000
  integer pointer msg;                                                  02620000
  integer Length;                                                       02621000
                                                                        02622000
  std'decl2;   << qhead/qtail >>                                        02623000
  std'decl;                                                             02624000
                                                                        02625000
                                                                        02626000
<< Send'DB :    primary entry point >>                                  02627000
    Length := Message(1);                                               02628000
    MsgMode := FALSE;                                                   02629000
    GOTO FillMsg;                                                       02630000
                                                                        02631000
Send'Q :   << secondary entry point >>                                  02632000
    @Message := @Message - deltaQ;  << fixup Message addr >>            02633000
    GOTO Scontinue;                                                     02634000
                                                                        02635000
Send'S :   << secondary entry point >>                                  02636000
    << in this case, @Message is really the length of the msg >>        02637000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 02638000
    << fall through into Scontinue >>                                   02639000
                                                                        02640000
Scontinue :                                                             02641000
    Length := QM0array(@Message +1);                                    02642000
    MsgMode := TRUE;                                                    02643000
                                                                        02644000
<<>>                                                                    02645000
                                                                        02646000
FillMsg :                                                               02647000
  exchangeDB'to'PortDST;                                                02648000
                                                            <<00037>>   02649000
  if PortCB'delete or PortCB'free then                      <<00037>>   02650000
    suddendeath(badport);                                   <<00037>>   02651000
                                                            <<00037>>   02652000
  allocate'message'frame;                                               02653000
  if @msg = 0 then suddendeath(badport);  << ICS only >>                02654000
                                                                        02655000
  if not (2 <= Length <= PortDSTMaxMsgSize) then            <<00004>>   02656000
    suddendeath(badportcall);  << +*+ >>                                02657000
  tos := AbsPortDB;     << move the data into the msg buffer >>         02658000
  tos := tos + @msg;                                                    02659000
  if MsgMode then begin CalcAbsQ end else TOS := CallersDB;             02660000
  TOS := TOS + @Message;                                                02661000
  tos := Length;                                                        02662000
  mabs5;  << perform an absolute move, and pop all parameters >>        02663000
                                                                        02664000
  goto enqueue'msg;                                                     02665000
                                                                        02666000
<<>>                                                                    02667000
                                                                        02668000
Send'Ref :   << secondary entry point >>                                02669000
  turn'traps'off;                                                       02670000
  pdisable;                                                             02671000
  PUSH(DB);   << simulate exchangedb'to'PortDST >>                      02672000
  asmb( ddup );  << NOTE: in this path, AbsMessage is NOT allocated >>  02673000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       02674000
  Length := Message(1);  << +*+ >>                                      02675000
  if not (2 <= Length <= PortDSTMaxMsgSize) then            <<00004>>   02676000
    suddendeath(badportcall);  << +*+ >>                                02677000
                                                                        02678000
  @msg := @Message;                                                     02679000
  << fall through into enqueue'msg >>                                   02680000
                                                                        02681000
<<>>                                                                    02682000
                                                                        02683000
enqueue'msg :                                                           02684000
  if not (0 <= Subqueue <= PortDSTMaxSubqueue) then         <<00004>>   02685000
    suddendeath(badportcall);<< +*+ >>                      <<00004>>   02686000
                << queue the message to the port >>                     02687000
  msg := 0;  << break msg link into free pool >>                        02688000
  disable;                                                              02689000
  << if PortCB'delete then suddendeath >>                               02690000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   02691000
  if @qhead <> 0 then                                                   02692000
    begin  << not the first message >>                                  02693000
    @qtail := qtail := @msg;  << queue to tail >>                       02694000
    PortCB'dbl(x) := dbl'ptrs;                                          02695000
    end                                                                 02696000
  else                                                                  02697000
    begin  << first message in the queue >>                             02698000
    tos := tos := @msg;  << queue to the front >>                       02699000
    PortCB'dbl(x) := tos;                                               02700000
    set'message'bit;  << set flags to indicate a msg is present >>      02701000
    end;                                                                02702000
                                                                        02703000
  tos := PortCB'dbl;   << load both flags and mask words >>             02704000
  asmb( and,del );                                                      02705000
  if <> and PortCB'enabled and not PortCB'active then                   02706000
    begin  << run the port procedure >>                                 02707000
    if not PortCB'type.pdisabled then                                   02708000
      begin                                                             02709000
      PortDispatcher(PortId);  << PortDisp will exchangedb'back >>      02710000
      return;                                                           02711000
      end                                                               02712000
    else                                                                02713000
      begin   << callable in any enviorment, including ICS >>           02714000
      << This code is duplicated from PortDispatcher for >>             02715000
      << performance reasons. >>                                        02716000
                                                                        02717000
      << run the server procedure >>                                    02718000
      PortCB'active := true;  << mutual exclusion semaphore >>          02719000
      dequeue'hipri'message;                                            02720000
      do begin                                                          02721000
        enable;                                                         02722000
        << actually run the server here >>                              02723000
        tos := PortId;                                                  02724000
        tos := PortCB'context;                                          02725000
        tos := @msg;                                                    02726000
        tos := PortCB'server'plabel;                                    02727000
        asmb( pcal 0 );                                                 02728000
                                                                        02729000
        << check for more messages >>                                   02730000
        disable;                                                        02731000
        if PortCB'enabled and not PortCB'delete                         02732000
          then dequeue'hipri'message                                    02733000
          else @msg := 0;                                               02734000
      end until @msg = 0;                                               02735000
                                                                        02736000
      PortCB'active := false;  << mutual exclusion no longer needed >>  02737000
      enable;                                                           02738000
      if PortCB'delete then                                             02739000
        begin                                                           02740000
        exchangedb'back;  << CallersDB/AbsPortDB is popped >>           02741000
        DeletePort(PortId);                                             02742000
        end                                                             02743000
      else exchangedb'back;  << CallersDB/AbsPortDB is popped >>        02744000
      return;  << exit Send >>                                          02745000
      end;  << ICS-Port >>                                              02746000
                                                                        02747000
    end;  << done with running of the port procedure >>                 02748000
                                                                        02749000
   << port procedure not activated >>                                   02750000
                                                                        02751000
  bump'holder'process;                                      <<00044>>   02752000
  enable;                                                               02753000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02754000
  end;  << Send >>                                                      02755000
$page "Receive"                                                         02756000
procedure Receive'DB(PortId,Message,EnableMask);                        02757000
  value PortId,Message,EnableMask;                                      02758000
  double PortId;                                                        02759000
  integer pointer Message;                                              02760000
  logical EnableMask;                                                   02761000
  option privileged,uncallable;                                         02762000
                                                                        02763000
<< Note:  Message is really a Pascal type record.  The first >>         02764000
<<   word of message is the subqueue of the port to receive the >>      02765000
<<   message.  The second word is a positive word count of the >>       02766000
<<   message length, not including the two word header. >>              02767000
  begin                                                                 02768000
                                                                        02769000
comment  Algorithm:                                                     02770000
    Find the highest priority, enabled subqueue with a message.         02771000
    Dequeue the first msg from the subqueue.                            02772000
    Move the msg data to the caller's data area.                        02773000
    Return the msg back to the free pool.                               02774000
  ;                                                                     02775000
                                                                        02776000
  entry Receive'Q,                                                      02777000
        Receive'S;                                                      02778000
                                                                        02779000
  integer Subqueue;                                                     02780000
  logical OldMask;  << save the original subqueue enable state >>       02781000
  integer pointer msg;                                                  02782000
                                                                        02783000
  std'decl2;   << qhead/qtail >>                                        02784000
  std'decl;                                                             02785000
                                                                        02786000
                                                                        02787000
<< Receive'DB :    primary entry point >>                               02788000
    exchangedb'to'PortDST;                                              02789000
    tos := CallersDB;                                                   02790000
    tos := tos + @Message;  << initializes AbsMessage >>                02791000
    GOTO GetMsg;                                                        02792000
                                                                        02793000
Receive'Q :   << secondary entry point >>                               02794000
    @Message := @Message - deltaQ;  << fixup Message addr >>            02795000
    GOTO Scontinue;                                                     02796000
                                                                        02797000
Receive'S :   << secondary entry point >>                               02798000
    << in this case, @Message is really the length of the msg >>        02799000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 02800000
  << fall through into Scontinue >>                                     02801000
                                                                        02802000
Scontinue :                                                             02803000
    exchangedb'to'PortDST;                                              02804000
    CalcAbsQ;  << push absolute bank and address onto tos >>            02805000
    tos := tos + @Message;  << initializes AbsMessage >>                02806000
                                                                        02807000
<<>>                                                                    02808000
                                                                        02809000
GetMsg :        << find the highest priority subqueue >>                02810000
  disable;                                                              02811000
  OldMask := PortCB'mask;  << save a copy of the original state >>      02812000
  PortCB'mask := OldMask lor EnableMask;  << enable subqueues >>        02813000
  dequeue'hipri'message;                                                02814000
  PortCB'mask := OldMask;  << restore old subqueue enable state >>      02815000
  enable;                                                               02816000
                                                                        02817000
  if @msg = 0 then                                                      02818000
    begin  << return a nil indication >>                                02819000
    << AbsMessage is on tos >>                                          02820000
    tos := -1;  tos := 2;  << Subqueue = -1, Length = 2 >>              02821000
    asmb( sdea );                                                       02822000
    asmb( ddel );  << delete AbsMessage >>                              02823000
    end                                                                 02824000
  else                                                                  02825000
    begin       << return the message to the caller >>                  02826000
    tos := AbsMessage;                                                  02827000
    tos := AbsPortDB;                                                   02828000
    tos := tos + @msg;                                                  02829000
    tos := msg(msg'length);                                             02830000
    mabs5;  << perform an absolute move, and pop all parameters >>      02831000
    asmb( ddel );  << delete AbsMessage >>                              02832000
                                                                        02833000
    release'message'frame;  << return the msg back to the free pool >>  02834000
    end;                                                                02835000
                                                                        02836000
  << DB back to callers db >>                                           02837000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02838000
  end;  << Receive >>                                                   02839000
$page "Receive'Ref"                                                     02840000
integer procedure Receive'Ref(PortId,Dummy,EnableMask);                 02841000
  value PortId,Dummy,EnableMask;                                        02842000
  double PortId;                                                        02843000
  integer Dummy;  << serves only to standardize calling sequence >>     02844000
  logical EnableMask;                                                   02845000
  option privileged,uncallable;                                         02846000
                                                                        02847000
<< Note:  Message is really a Pascal type record.  The first >>         02848000
<<   word of message is the subqueue of the port to receive the >>      02849000
<<   message.  The second word is a positive word count of the >>       02850000
<<   message length, not including the two word header. >>              02851000
  begin                                                                 02852000
                                                                        02853000
comment  Algorithm:                                                     02854000
    Find the highest priority, enabled subqueue with a message.         02855000
    Dequeue the first msg from the subqueue.                            02856000
    Return a pointer to the message.                                    02857000
  ;                                                                     02858000
                                                                        02859000
  integer Subqueue;                                                     02860000
  logical OldMask;  << save the original subqueue enable state >>       02861000
  integer pointer msg = Receive'Ref;                                    02862000
                                                                        02863000
  std'decl2;   << qhead/qtail >>                                        02864000
  std'decl;                                                             02865000
                                                                        02866000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       02867000
  disable;                                                              02868000
  OldMask := PortCB'mask;  << save a copy of the original state >>      02869000
  PortCB'mask := OldMask lor EnableMask;  << enable subqueues >>        02870000
  dequeue'hipri'message;                                                02871000
  PortCB'mask := OldMask;  << restore old subqueue enable state >>      02872000
  enable;                                                               02873000
  end;  << Receive'Ref >>                                               02874000
$page "ReceiveWait"                                                     02875000
                                                                        02876000
<< Note: ReceiveWait is really one of the advanced level >>             02877000
<<       port procedure primitives. >>                                  02878000
                                                                        02879000
procedure ReceiveWait'server(PortId,Context,Message);                   02880000
  value PortId,Context,Message;                                         02881000
  double PortId;                                                        02882000
  integer pointer Context,Message;                                      02883000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 02884000
  << +*+ Need to add a procedure to create process-server Ports >>      02885000
  begin                                                                 02886000
  logical pointer PortCB = PortId +1;                                   02887000
  integer Subqueue;                                                     02888000
                                                                        02889000
  Subqueue := Message << (0) >>;                                        02890000
  << The following should probably be replaced >>                       02891000
  PortDisable(PortId);                                                  02892000
  Replace'Ref(PortId,Subqueue,Message);                                 02893000
  PortMaskEnable(PortId,1&csr(Subqueue +1));  << Re-enable mask >>      02894000
                                                                        02895000
  awake(integer(PortCB'pin)*pcbsize,msgwaitcode,nowait);                02896000
                                                                        02897000
  end;   << ReceiveWait'server >>                                       02898000
                                                                        02899000
procedure ReceiveWait'DB(PortId,Message,EnableMask);                    02900000
  value PortId,Message,EnableMask;                                      02901000
  double PortId;                                                        02902000
  integer pointer Message;                                              02903000
  logical EnableMask;                                                   02904000
  option privileged,uncallable;                                         02905000
                                                                        02906000
<< Note:  Message is really a Pascal type record.  The first >>         02907000
<<   word of message is the subqueue of the port to receive the >>      02908000
<<   message.  The second word is a positive word count of the >>       02909000
<<   message length, not including the two word header. >>              02910000
  begin                                                                 02911000
                                                                        02912000
comment  Algorithm:                                                     02913000
    Find the highest priority, enabled subqueue with a message.         02914000
    Dequeue the first msg from the subqueue.                            02915000
    Move the msg data to the caller's data area.                        02916000
    Return the msg back to the free pool.                               02917000
  ;                                                                     02918000
                                                                        02919000
  integer Subqueue;                                                     02920000
  logical MsgMode;  << used to indicate DB vs stack >>                  02921000
  logical OldMask;  << save the original subqueue enable state >>       02922000
  logical firstime := true;  << to signal saving state>>    <<00017>>   02923000
  integer pointer msg;                                                  02924000
                                                                        02925000
  std'decl2;   << qhead/qtail >>                                        02926000
  std'decl;                                                             02927000
                                                                        02928000
  entry ReceiveWait'Q,                                                  02929000
        ReceiveWait'S;                                                  02930000
                                                                        02931000
                                                                        02932000
<< ReceiveWait'DB :    primary entry point >>                           02933000
    MsgMode := false;  << indicate DB relative message >>               02934000
    GOTO GetMsg;                                                        02935000
                                                                        02936000
ReceiveWait'Q :   << secondary entry point >>                           02937000
    @Message := @Message - deltaQ;  << fixup Message addr >>            02938000
    GOTO Scontinue;                                                     02939000
                                                                        02940000
ReceiveWait'S :   << secondary entry point >>                           02941000
    << in this case, @Message is really the length of the msg >>        02942000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 02943000
    << fall through into Scontinue >>                                   02944000
                                                                        02945000
Scontinue :                                                             02946000
    MsgMode := true;  << means that the message is stack relative >>    02947000
                                                                        02948000
<<>>                                                                    02949000
                                                                        02950000
GetMsg :        << find the highest priority subqueue >>                02951000
  exchangeDB'to'PortDST;                                                02952000
                                                            <<00046>>   02953000
  if portcb'subtype = iowait'subtype then                   <<00046>>   02954000
    suddendeath(badportcall);                               <<00046>>   02955000
                                                            <<00046>>   02956000
  disable;                                                              02957000
  if firstime then OldMask := PortCB'mask; << save state>>  <<00017>>   02958000
  firstime := false; << don't save original state anymore>> <<00017>>   02959000
  PortCB'mask := OldMask lor EnableMask;  << enable subqueues >>        02960000
  dequeue'hipri'message;                                                02961000
                                                                        02962000
  if @msg = 0 then                                                      02963000
    begin  << wait for a message >>                                     02964000
    PortCB'server'plabel := @ReceiveWait'server;                        02965000
    PortCB'type := 3;  << server called pdisabled, DB @ PortDST >>      02966000
    PortCB'enabled := true;                                             02967000
    PortCB'pin := curpin;                                               02968000
    clearwws;  << clear previous awake flags >>                         02969000
    enable;                                                             02970000
                                                                        02971000
    exchangedb'back;  << CallersDB/AbsPortDB is popped >>               02972000
    wait(-msgwaitcode,noinfo);  << neg. means check WWS >>              02973000
    goto GetMsg;                                                        02974000
    end                                                                 02975000
  else                                                                  02976000
    begin       << return the message to the caller >>                  02977000
    PortCB'mask := OldMask;  << restore old subqueue enable state >>    02978000
    enable;                                                             02979000
    if MsgMode then begin CalcAbsQ end else TOS := CallersDB;           02980000
    TOS := TOS + @Message;                                              02981000
    tos := AbsPortDB;                                                   02982000
    tos := tos + @msg;                                                  02983000
    tos := msg(msg'length);                                             02984000
    mabs5;  << perform an absolute move, and pop all parameters >>      02985000
                                                                        02986000
                                                                        02987000
    release'message'frame;  << return the msg back to the free pool >>  02988000
    end;                                                                02989000
                                                                        02990000
  << DB back to callers db >>                                           02991000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02992000
  end;  << Receive >>                                                   02993000
$page "Replace"                                                         02994000
procedure Replace'DB(PortId,Subqueue,Message);                          02995000
  value PortId,Subqueue,Message;                                        02996000
  double PortId;                                                        02997000
  integer Subqueue;                                                     02998000
  integer pointer Message;                                              02999000
  option privileged,uncallable;                                         03000000
                                                                        03001000
<< Note:  Message is really a Pascal type record.  The first >>         03002000
<<   word of message is the subqueue of the port to receive the >>      03003000
<<   message.  Note that subqueue is ignored by the Replace >>          03004000
<<   primitives.  The second word is a positive word count of the >>    03005000
<<   message length, INCLUDING the two word header. >>                  03006000
  begin                                                                 03007000
comment  Algorithm:                                                     03008000
    Get a msg buffer from the free pool.                                03009000
    Move the caller's data into the msg buffer.                         03010000
    Queue the msg buffer to head of the port.                           03011000
    Disable the subqueue that the message is enqueued upon.             03012000
  ;                                                                     03013000
                                                                        03014000
  entry Replace'Q,   << secondary entry points >>                       03015000
        Replace'S,                                                      03016000
        Replace'Ref;                                                    03017000
                                                                        03018000
  integer array QM0array(*) = Q-0;                                      03019000
logical MsgMode;                                                        03020000
  integer pointer msg;                                                  03021000
  integer Length;                                                       03022000
                                                                        03023000
  std'decl2;   << qhead/qtail >>                                        03024000
  std'decl;                                                             03025000
                                                                        03026000
                                                                        03027000
<< Replace'DB :    primary entry point >>                               03028000
    Length := Message(1);                                               03029000
    MsgMode := FALSE;                                                   03030000
    GOTO FillMsg;                                                       03031000
                                                                        03032000
Replace'Q :   << secondary entry point >>                               03033000
    @Message := @Message - deltaQ;  << fixup Message addr >>            03034000
    GOTO Scontinue;                                                     03035000
                                                                        03036000
Replace'S :   << secondary entry point >>                               03037000
    << in this case, @Message is really the length of the msg >>        03038000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 03039000
  << fall through into Scontinue >>                                     03040000
                                                                        03041000
Scontinue :                                                             03042000
    Length := QM0array(@Message +1);                                    03043000
    MsgMode := TRUE;                                                    03044000
                                                                        03045000
<<>>                                                                    03046000
                                                                        03047000
FillMsg :                                                               03048000
  exchangeDB'to'PortDST;                                                03049000
  allocate'message'frame;                                               03050000
  if @msg = 0 then suddendeath(badport);  << ICS only >>                03051000
                                                                        03052000
  if not (2 <= Length <= PortDSTMaxMsgSize) then            <<00004>>   03053000
    suddendeath(badportcall);  << +*+ >>                                03054000
  tos := AbsPortDB;     << move the data into the msg buffer >>         03055000
  tos := tos + @msg;                                                    03056000
    if MsgMode then begin CalcAbsQ end else TOS := CallersDB;           03057000
    TOS := TOS + @Message;                                              03058000
  tos := Length;                                                        03059000
  mabs5;  << perform an absolute move, and pop all parameters >>        03060000
                                                                        03061000
  goto enqueue'msg;                                                     03062000
                                                                        03063000
<<>>                                                                    03064000
                                                                        03065000
Replace'Ref :   << secondary entry point >>                             03066000
  turn'traps'off;                                                       03067000
  pdisable;                                                             03068000
  PUSH(DB);   << simulate exchangedb'to'portdst >>                      03069000
  asmb( ddup );  << NOTE: in this path, AbsMessage is NOT allocated >>  03070000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       03071000
  Length := Message(1);  << +*+ >>                                      03072000
  if not (2 <= Length <= PortDSTMaxMsgSize) then            <<00004>>   03073000
    suddendeath(badportcall);  << +*+ >>                                03074000
                                                                        03075000
  @msg := @Message;                                                     03076000
  << fall through into enqueue'msg >>                                   03077000
                                                                        03078000
<<>>                                                                    03079000
                                                                        03080000
enqueue'msg :                                                           03081000
  if not (0 <= Subqueue <= PortDSTMaxSubqueue) then         <<00004>>   03082000
    suddendeath(badportcall);<< +*+ >>                      <<00004>>   03083000
                     << queue the message to the port >>                03084000
  disable;                                                              03085000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   03086000
  msg := @qhead;  << Link message to head of subqueue >>                03087000
  if = then                                                             03088000
    begin  << only message in the subqueue >>                           03089000
    tos := tos := @msg;  << update both head and tail pointers >>       03090000
    PortCB'dbl(x) := tos;                                               03091000
    set'message'bit;  << set flags to indicate a msg is present >>      03092000
    end                                                                 03093000
  else                                                                  03094000
    begin  << not the only message, but queue to front >>               03095000
    @qhead := @msg;                                                     03096000
    PortCB'dbl(x) := dbl'ptrs;                                          03097000
    end;                                                                03098000
                                                                        03099000
  << disable the subqueue >>                                            03100000
  tos := PortCB'mask;                                                   03101000
  x := Subqueue;                                                        03102000
  asmb( trbc 0,x );                                                     03103000
  PortCB'mask := tos;                                                   03104000
  enable;                                                               03105000
                                                                        03106000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03107000
  end;  << Replace >>                                                   03108000
$page "Discard and GetMessage"                                          03109000
procedure Discard'Ref(PortId,Message);                                  03110000
  value PortId,Message;                                                 03111000
  double PortId;                                                        03112000
  integer pointer Message;                                              03113000
  option privileged,uncallable;                                         03114000
                                                                        03115000
  begin                                                                 03116000
  integer pointer msg = Message;  << alias for defines >>               03117000
  std'decl;   << declare AbsDB variables >>                             03118000
                                                                        03119000
  turn'traps'off;   << simulate exchangedb to PortDST >>                03120000
  pdisable;                                                             03121000
  PUSH(DB);                                                             03122000
  asmb( ddup );                                                         03123000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       03124000
                                                                        03125000
  release'message'frame;                                                03126000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03127000
  end;  << Discard'Ref >>                                               03128000
                                                                        03129000
integer procedure GetMessage'Ref(PortId);                               03130000
  value PortId;                                                         03131000
  double PortId;                                                        03132000
  option privileged,uncallable;                                         03133000
                                                                        03134000
  begin                                                                 03135000
  integer pointer msg = GetMessage'Ref;                                 03136000
  std'decl;   << declare AbsDB variables >>                             03137000
                                                                        03138000
  turn'traps'off;   << simulate exchangedb to PortDST >>                03139000
  pdisable;                                                             03140000
  PUSH(DB);                                                             03141000
  asmb( ddup );                                                         03142000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       03143000
                                                                        03144000
  allocate'message'frame;                                               03145000
  if @msg <> 0 then begin                                   <<00023>>   03146000
    msg := 0;                                               <<00019>>   03147000
    move msg(1) := msg,(PortDSTMaxMsgSize - 1);             <<00019>>   03148000
  end;                                                      <<00023>>   03149000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03150000
  end;  << GetMessage'Ref >>                                            03151000
integer procedure GetMessageRef(PortId);                    <<00028>>   03152000
  value PortId;                                                         03153000
  double PortId;                                                        03154000
  option privileged,uncallable;                                         03155000
<< same as GetMessage'Ref but doesn't wait if no msg available >>       03156000
  begin                                                                 03157000
  integer pointer msg = GetMessageRef;                                  03158000
  std'decl;  << declare AbsDB variables >>                              03159000
                                                                        03160000
  turn'traps'off;  << simulate exchangedb to PortDST >>                 03161000
  pdisable;                                                             03162000
  PUSH(DB);                                                             03163000
  asmb( ddup );                                                         03164000
  if PortDST <> PortDSTnum then suddendeath(wrongDST); << +*+ >>        03165000
                                                                        03166000
  disable;                                                              03167000
  if PoolCnt <= 0 then                                                  03168000
    begin @msg := 0; enable; end<<don't dip into secondary pool >>      03169000
  else                                                                  03170000
    begin                                                               03171000
    PoolCnt := PoolCnt - 1;                                             03172000
    @msg := @MsgPoolHead;                                               03173000
    @MsgPoolHead := MsgPoolHead;                                        03174000
    if = then @MsgPoolTail := 0;                                        03175000
    enable;                                                             03176000
    msg := 0;                                                           03177000
    move msg(1) := msg,(PortDSTMaxMsgSize - 1);                         03178000
    end;                                                                03179000
  exchangedb'back; << CallersDB/AbsPortDB is popped >>                  03180000
  end;          << GetMessageRef >>                                     03181000
$page "PortMaskDisable and PortMaskEnable"                              03182000
procedure PortMaskDisable(PortId,DisableMask);                          03183000
  value PortId,DisableMask;                                             03184000
  double PortId;                                                        03185000
  logical DisableMask;                                                  03186000
  option privileged,uncallable;                                         03187000
                                                                        03188000
  begin                                                                 03189000
  std'decl;                                                             03190000
                                                                        03191000
  exchangedb'to'PortDST;                                                03192000
                                                                        03193000
  disable;                                                              03194000
  PortCB'mask := PortCB'mask land not DisableMask;                      03195000
  enable;                                                               03196000
                                                                        03197000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03198000
  end;  << PortMaskDisable >>                                           03199000
                                                                        03200000
procedure PortMaskEnable(PortId,EnableMask);                            03201000
  value PortId,EnableMask;                                              03202000
  double PortId;                                                        03203000
  logical EnableMask;                                                   03204000
  option privileged,uncallable;                                         03205000
                                                                        03206000
  begin                                                                 03207000
  integer Subqueue;                                                     03208000
  integer pointer msg;                                                  03209000
                                                                        03210000
  std'decl2;   << qhead/qtail >>                                        03211000
  std'decl;                                                             03212000
                                                                        03213000
  exchangedb'to'PortDST;                                                03214000
                                                                        03215000
  disable;                                                              03216000
  PortCB'mask := PortCB'mask lor EnableMask;                            03217000
  << need to check if activation of port procedure necessary >>         03218000
  tos := PortCB'dbl;   << get both mask and flags >>                    03219000
  asmb( and,del );                                                      03220000
  if <> and PortCB'enabled and not PortCB'active then                   03221000
    begin  << run the port procedure >>                                 03222000
    if not PortCB'type.pdisabled then                                   03223000
      begin                                                             03224000
      PortDispatcher(PortId);  << PortDisp will exchangedb'back >>      03225000
      return;                                                           03226000
      end                                                               03227000
    else                                                                03228000
      begin   << callable in any enviorment, including ICS >>           03229000
      << This code is duplicated from PortDispatcher for >>             03230000
      << performance reasons. >>                                        03231000
                                                                        03232000
      << run the server procedure >>                                    03233000
      PortCB'active := true;  << mutual exclusion semaphore >>          03234000
      dequeue'hipri'message;                                            03235000
      do begin                                                          03236000
        enable;                                                         03237000
        << actually run the server here >>                              03238000
        tos := PortId;                                                  03239000
        tos := PortCB'context;                                          03240000
        tos := @msg;                                                    03241000
        tos := PortCB'server'plabel;                                    03242000
        asmb( pcal 0 );                                                 03243000
                                                                        03244000
        << check for more messages >>                                   03245000
        disable;                                                        03246000
        if PortCB'enabled and not PortCB'delete                         03247000
          then dequeue'hipri'message                                    03248000
          else @msg := 0;                                               03249000
      end until @msg = 0;                                               03250000
                                                                        03251000
      PortCB'active := false;  << mutual exclusion no longer needed >>  03252000
      enable;                                                           03253000
      if PortCB'delete then                                             03254000
        begin                                                           03255000
        exchangedb'back;  << CallersDB/AbsPortDB is popped >>           03256000
        DeletePort(PortId);                                             03257000
        end                                                             03258000
      else exchangedb'back;  << CallersDB/AbsPortDB is popped >>        03259000
      return;  << exit PortMaskEnable >>                                03260000
      end;  << ICS-Port >>                                              03261000
    end;  << done with running of the port procedure >>                 03262000
                                                                        03263000
  bump'holder'process;                                      <<00044>>   03264000
  enable;                                                               03265000
                                                                        03266000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03267000
  end;  << PortMaskEnable >>                                            03268000
Logical Procedure SetPortMask(PortId, Mask);                <<00027>>   03269000
  value PortId,Mask;                                                    03270000
  double PortId;                                                        03271000
  logical Mask;                                                         03272000
  option privileged,uncallable;                                         03273000
                                                                        03274000
  begin                                                                 03275000
  integer Subqueue;                                                     03276000
  integer pointer msg;                                                  03277000
                                                                        03278000
  std'decl2;  << qhead/qtail >>                                         03279000
  std'decl;                                                             03280000
                                                                        03281000
  exchangedb'to'PortDST;                                                03282000
                                                                        03283000
  disable;                                                              03284000
  SetPortMask := PortCB'mask;                                           03285000
  PortCB'mask := Mask;                                                  03286000
 << need to check if activation of port procedure necessary >>          03287000
  tos := PortCB'dbl;  << get both mask and flags >>                     03288000
  asmb( and,del );                                                      03289000
  if <> and PortCB'enabled and not PortCB'active then                   03290000
    begin << run the port procedure >>                                  03291000
    if not PortCB'type.pdisabled then                                   03292000
      begin                                                             03293000
      PortDispatcher(PortId); << PortDisp will exchangedb'back >>       03294000
      return;                                                           03295000
      end                                                               03296000
    else                                                                03297000
      begin  << callable in any enviorment, including ICS >>            03298000
     << This code is duplicated from PortDispatcher for >>              03299000
     << performance reasons. >>                                         03300000
                                                                        03301000
     << run the server procedure >>                                     03302000
      PortCB'active := true; << mutual exclusion semaphore >>           03303000
      dequeue'hipri'message;                                            03304000
      do begin                                                          03305000
        enable;                                                         03306000
       << actually run the server here >>                               03307000
        tos := PortId;                                                  03308000
        tos := PortCB'context;                                          03309000
        tos := @msg;                                                    03310000
        tos := PortCB'server'plabel;                                    03311000
        asmb( pcal 0 );                                                 03312000
                                                                        03313000
       << check for more messages >>                                    03314000
        disable;                                                        03315000
        if PortCB'enabled and not PortCB'delete                         03316000
          then dequeue'hipri'message                                    03317000
          else @msg := 0;                                               03318000
      end until @msg = 0;                                               03319000
                                                                        03320000
      PortCB'active := false; << mutual exclusion no longer needed >>   03321000
      enable;                                                           03322000
      if PortCB'delete then                                             03323000
        begin                                                           03324000
        exchangedb'back; << CallersDB/AbsPortDB is popped >>            03325000
        DeletePort(PortId);                                             03326000
        end                                                             03327000
      else exchangedb'back; << CallersDB/AbsPortDB is popped >>         03328000
      return; << exit SetPortMask >>                                    03329000
      end; << ICS-Port >>                                               03330000
    end; << done with running of the port procedure >>                  03331000
  enable;                                                               03332000
                                                                        03333000
  exchangedb'back; << CallersDB/AbsPortDB is popped >>                  03334000
  end; << SetPortMask >>                                                03335000
$page "PortDisable and PortEnable"                                      03336000
<< PortDisable and PortEnable should NOT be callable from >>            03337000
<< port procedures.  They are reserved for the advanced level >>        03338000
<< of ports.  (Or maybe process servers?) >>                            03339000
<< This restriction may have changed with the addition of >>            03340000
<< PortCB'active to destinguish enabled vs. active.  SF 7/2/82 >>       03341000
                                                                        03342000
logical procedure PortDisable(PortId);                                  03343000
  value PortId;                                                         03344000
  double PortId;                                                        03345000
  option privileged,uncallable;                                         03346000
                                                                        03347000
  begin                                                                 03348000
  std'decl;                                                             03349000
                                                                        03350000
  exchangedb'to'PortDST;                                                03351000
                                                                        03352000
  disable;                                                              03353000
  PortDisable := PortCB'enabled;                                        03354000
  PortCB'enabled := false;                                              03355000
  enable;                                                               03356000
                                                                        03357000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03358000
  end;  << PortDisable >>                                               03359000
                                                                        03360000
logical procedure PortEnable(PortId);                                   03361000
  value PortId;                                                         03362000
  double PortId;                                                        03363000
  option privileged,uncallable;                                         03364000
                                                                        03365000
  begin                                                                 03366000
  integer Subqueue;                                                     03367000
  integer pointer msg;                                                  03368000
                                                                        03369000
  std'decl2;   << qhead/qtail >>                                        03370000
  std'decl;                                                             03371000
                                                                        03372000
  exchangedb'to'PortDST;                                                03373000
                                                                        03374000
  disable;                                                              03375000
  PortEnable := PortCB'enabled;                                         03376000
  PortCB'enabled := true;                                               03377000
  << need to check if activation of port procedure necessary >>         03378000
  tos := PortCB'dbl;   << get both mask and flags >>                    03379000
  asmb( and,del );                                                      03380000
  if <> <<and PortCB'enabled>> and not PortCB'active then               03381000
    begin  << run the port procedure >>                                 03382000
    if not PortCB'type.pdisabled then                                   03383000
      begin                                                             03384000
      PortDispatcher(PortId);  << PortDisp will exchangedb'back >>      03385000
      return;                                                           03386000
      end                                                               03387000
    else                                                                03388000
      begin   << callable in any enviorment, including ICS >>           03389000
      << This code is duplicated from PortDispatcher for >>             03390000
      << performance reasons. >>                                        03391000
                                                                        03392000
      << run the server procedure >>                                    03393000
      PortCB'active := true;  << mutual exclusion semaphore >>          03394000
      dequeue'hipri'message;                                            03395000
      do begin                                                          03396000
        enable;                                                         03397000
        << actually run the server here >>                              03398000
        tos := PortId;                                                  03399000
        tos := PortCB'context;                                          03400000
        tos := @msg;                                                    03401000
        tos := PortCB'server'plabel;                                    03402000
        asmb( pcal 0 );                                                 03403000
                                                                        03404000
        << check for more messages >>                                   03405000
        disable;                                                        03406000
        if PortCB'enabled and not PortCB'delete                         03407000
          then dequeue'hipri'message                                    03408000
          else @msg := 0;                                               03409000
      end until @msg = 0;                                               03410000
                                                                        03411000
      PortCB'active := false;  << mutual exclusion no longer needed >>  03412000
      enable;                                                           03413000
      if PortCB'delete then                                             03414000
        begin                                                           03415000
        exchangedb'back;  << CallersDB/AbsPortDB is popped >>           03416000
        DeletePort(PortId);                                             03417000
        end                                                             03418000
      else exchangedb'back;  << CallersDB/AbsPortDB is popped >>        03419000
      return;  << exit PortEnable >>                                    03420000
      end;  << ICS-Port >>                                              03421000
    end;  << done with running of the port procedure >>                 03422000
                                                                        03423000
  bump'holder'process;                                      <<00044>>   03424000
  enable;                                                               03425000
                                                                        03426000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03427000
  end;  << PortEnable >>                                                03428000
$page "NewPortStatus"                                                   03429000
integer procedure NewPortStatus(PortId,Type);                           03430000
  value PortId,Type;                                                    03431000
  double PortId;                                                        03432000
  integer Type;                                                         03433000
  option privileged,uncallable;                                         03434000
                                                                        03435000
  begin                                                                 03436000
  std'decl;                                                             03437000
                                                                        03438000
  exchangedb'to'PortDST;                                                03439000
                                                                        03440000
  case Type of                                                          03441000
    begin                                                               03442000
<<0>> NewPortStatus := PortCB'flags;                                    03443000
<<1>> NewPortStatus := PortCB'mask;                                     03444000
<<2>> NewPortStatus := PoolCnt;  << should be a diff procedure >>       03445000
<<3>> NewPortStatus := @UserRegionPointer;                  <<00040>>   03446000
<<4>> NewPortStatus := PortDstMaxPorts;                     <<00040>>   03447000
<<5>> NewPortStatus := PortDstNumPorts;                     <<00040>>   03448000
<<6>> NewPortStatus := PortDstMaxMsgSize;                   <<00040>>   03449000
<<7>> NewPortStatus := PortDstNum;                          <<00040>>   03450000
    end;                                                                03451000
                                                                        03452000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03453000
  end;  << NewPortStatus >>                                             03454000
integer procedure SoftIntPlabel(PortId);                                03455000
  value PortId;                                                         03456000
  double PortId;                                                        03457000
  option privileged,uncallable;                                         03458000
                                                                        03459000
  begin                                                                 03460000
  << NOTE: must be called on stack assoc. with port >>                  03461000
  << NOTE: must be called with DB at stack DB >>                        03462000
  integer pointer Context;                                              03463000
  std'decl;                                                             03464000
                                                                        03465000
  exchangedb'to'PortDST;                                                03466000
  @Context := PortCB'context;                                           03467000
                                                                        03468000
  SoftIntPlabel := IOWait'softint'plabel;                               03469000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03470000
                                                                        03471000
  end;   << SoftIntPlabel  >>                                           03472000
$page "CreatePort"                                                      03473000
                                                                        03474000
double procedure CreatePort(ClassName,PortDST,NewFrames);               03475000
  value PortDST,NewFrames;                                              03476000
  byte array ClassName;                                                 03477000
  integer PortDST,NewFrames;                                            03478000
  option privileged,uncallable;                                         03479000
                                                                        03480000
  begin                                                                 03481000
  double PortId;                                                        03482000
  integer pointer PortCB = PortId +1;                                   03483000
  integer Result;                                                       03484000
  array Name(0:7);  << massaged ClassName >>                            03485000
  integer array DictData(0:7) = Q;                                      03486000
  integer DictPlabel = DictData +0,                                     03487000
          DictType   = DictData +1,                                     03488000
          DictContext= DictData +2,                                     03489000
          DictMsgSize= DictData +3,                                     03490000
          DictNumSubqueues = DictData +4;                               03491000
                                                                        03492000
  CreatePort := 0D;                                                     03493000
  GenerateDictName(ClassName,Name);                                     03494000
                                                                        03495000
  DictFind(Name,DictData,Result);                                       03496000
  if Result <> 0 then return;                                           03497000
                                                                        03498000
CreatePort'(PortDST, DictType, DictPlabel, DictNumSubqueues,            03499000
            DictContext, PortId, Result);                               03500000
  CreatePort := PortId;                                                 03501000
                                                                        03502000
  end;   << CreatePort >>                                               03503000
                                                                        03504000
procedure CreatePort'(PortDST, Type, Plabel, NumSubqueues, ContextSize, 03505000
                      PortId',  Result);                                03506000
  value               PortDST, Type, Plabel, NumSubqueues, ContextSize; 03507000
  integer     Result, PortDST, Type, Plabel, NumSubqueues, ContextSize; 03508000
  double              PortId';                                          03509000
  option privileged, uncallable;                                        03510000
                                                                        03511000
  begin                                                                 03512000
  equate  badparm1 = 1,                                                 03513000
          badparm2 = 2,                                                 03514000
        badparm3 = 3,                                       <<00019>>   03515000
          badparm4 = 4,                                                 03516000
          badparm5 = 5,                                                 03517000
        outoframes = 9,                                     <<00005>>   03518000
          splitstk = 10;                                                03519000
equate  deletepending = 11;                                 <<00019>>   03520000
  double PortId;                                                        03521000
  integer PortDSTx = PortId, Status;                                    03522000
  integer pointer PortCB = PortId + 1,                                  03523000
                  msg;                                                  03524000
                                                                        03525000
    Result  := 0;                                                       03526000
    PortId' := 0D;                                                      03527000
    if badDST(PortDST) then                                             03528000
      begin Result := badparm1; go to Exit; end;                        03529000
    Wheres'DB;                                                          03530000
    if <> then                                                          03531000
      begin Result := splitstk; go to Exit; end;                        03532000
    if Type.(0:13) <> 0 then                                            03533000
      begin Result := badparm2; go to Exit; end;                        03534000
  if plabel > 0 then                                        <<00019>>   03535000
    begin Result := badparm3; go to Exit; end;              <<00019>>   03536000
    exchangedb'to'PortDST;                                              03537000
    Status := 0;                                                        03538000
    PortId := 0D;                                           <<00005>>   03539000
    if not (0 <= NumSubqueues <= PortDSTMaxSubqueue + 1) then           03540000
      begin Status := badparm4; go to Done; end;                        03541000
    if not (0 <= ContextSize <= PortDSTMaxContextSize) then             03542000
      begin Status := badparm5; go to Done; end;                        03543000
    if PortDSTMaxPorts < 0 then                             <<00019>>   03544000
       begin Status := deletepending; go to Done; end;      <<00019>>   03545000
    allocate'portCB'frame;                                  <<00005>>   03546000
    if @msg = 0 then                                        <<00005>>   03547000
      begin Status := outoframes; go to Done; end;          <<00005>>   03548000
    PortDSTx := PortDST;                                                03549000
    @PortCB := @msg;                                                    03550000
                                                                        03551000
    << zero out message frame >>                                        03552000
    PortCB := 0;                                                        03553000
    move PortCB(1) :=                                                   03554000
         PortCB,((SubqueuesOffset + PortDSTMaxSubqueue)&LSL(1) + 1);    03555000
                                                                        03556000
    << initialize context area >>                                       03557000
    if ContextSize = 0 then PortCB'context := 0                         03558000
    else                                                                03559000
      begin                                                             03560000
    allocate'ctx'frame;                                     <<00005>>   03561000
    if @msg = 0 then                                        <<00005>>   03562000
      begin                                                 <<00021>>   03563000
        Status := outoframes;                               <<00021>>   03564000
        PortId := 0D;                                       <<00021>>   03565000
        @msg   := @PortCB;                                  <<00033>>   03566000
        release'portCB'frame;                               <<00033>>   03567000
        go to Done;                                         <<00021>>   03568000
      end;                                                  <<00021>>   03569000
      PortCB'context := @msg;                                           03570000
      msg := 0;                                                         03571000
      move msg(1) := msg,(PortDSTMaxContextSize - 1);                   03572000
      end;                                                              03573000
                                                                        03574000
    PortCB'server'plabel := Plabel;                                     03575000
    PortCB'type := Type;                                                03576000
    PortCB'pin  := curpin;                                              03577000
                                                                        03578000
    PortDSTNumPorts := PortDSTNumPorts + 1;                 <<00019>>   03579000
Done: exchangedb'back;                                                  03580000
    PortId' := PortId;                                                  03581000
    Result := Status;                                                   03582000
Exit: end;                                                              03583000
procedure ChangePort(PortId,Pin);                           <<00030>>   03584000
  value              PortId,Pin;                            <<00030>>   03585000
  double             PortId;                                <<00030>>   03586000
  integer                   Pin;                            <<00030>>   03587000
  option privileged, uncallable;                            <<00030>>   03588000
                                                            <<00030>>   03589000
  begin                                                     <<00030>>   03590000
  std'decl;                                                 <<00030>>   03591000
  exchangedb'to'PortDST;                                    <<00030>>   03592000
  disable;                                                  <<00030>>   03593000
  PortCB'pin := Pin;                                        <<00030>>   03594000
  PortCB'offICS := true;                                    <<00030>>   03595000
  enable;                                                   <<00030>>   03596000
  exchangedb'back;                                          <<00030>>   03597000
                                                            <<00030>>   03598000
  end;   << ChangePort >>                                   <<00030>>   03599000
$page "TerminatePort"                                                   03600000
procedure TerminatePort(PortId);                                        03601000
  value PortId;                                                         03602000
  double PortId;                                                        03603000
  option privileged,uncallable;                                         03604000
                                                                        03605000
  begin                                                                 03606000
  std'decl;                                                             03607000
                                                                        03608000
  exchangedb'to'PortDST;                                                03609000
  disable;                                                              03610000
  << if not PortCB'active then suddendeath >>                           03611000
  PortCB'delete := true;  << mark as delete pending >>                  03612000
  enable;                                                               03613000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03614000
                                                                        03615000
  end;   << TerminatePort >>                                            03616000
$page "DeletePort"                                                      03617000
procedure DeletePort(PortId);                                           03618000
  value PortId;                                                         03619000
  double PortId;                                                        03620000
  option privileged,uncallable;                                         03621000
                                                                        03622000
  begin                                                                 03623000
  integer pointer msg;                                                  03624000
  integer pointer context;                                              03625000
  integer Subqueue,                                                     03626000
          aftioqx := 0;                                                 03627000
  logical release  := false;                                <<00019>>   03628000
                                                                        03629000
  std'decl2;   << qhead/qtail >>                                        03630000
  std'decl;                                                             03631000
  integer pointer IntPortCB = PortCB;  << declared in std'decl >>       03632000
                                                                        03633000
  exchangedb'to'PortDST;                                                03634000
  if PortCB'free then goto Done;                            <<00019>>   03635000
                                                                        03636000
  disable;                                                              03637000
  << if PortCB'active then suddendeath >>                               03638000
  PortCB'enabled := false;                                              03639000
  PortCB'mask := -1;                                                    03640000
                                                                        03641000
  dequeue'hipri'message;                                                03642000
  while @msg <> 0 do                                                    03643000
    begin                                                               03644000
    release'message'frame;                                              03645000
    disable;  << release'message'frame does an enable >>                03646000
    dequeue'hipri'message;                                              03647000
    end;                                                                03648000
  enable;                                                               03649000
  case PortCB'subtype of                                                03650000
    begin                                                               03651000
                                                                        03652000
    begin  << subtype 0.  "normal" ports >>                             03653000
    if (@msg := PortCB'context) <> 0 then                               03654000
    release'ctx'frame;                                      <<00005>>   03655000
    end;  << 0 >>                                                       03656000
                                                                        03657000
    begin  << subtype 1.  Semaphore ports >>                            03658000
    << Semaphore ports have no context area >>                          03659000
    if SemaphoreCnt <> 0 then suddendeath(badportcall);                 03660000
    end;                                                                03661000
                                                                        03662000
    begin  << subtype 2.  IOWait ports >>                               03663000
    @context := PortCB'context;                                         03664000
    if IOWait'count <> 0 then suddendeath(badportcall);                 03665000
    aftioqx := IOWait'aftioqx;                                          03666000
    @msg := @context;                                                   03667000
    release'ctx'frame;                                      <<00005>>   03668000
    end;  << 1 >>                                                       03669000
                                                                        03670000
    end;  << subtype case stmt >>                                       03671000
                                                                        03672000
  PortCB'free := true;                                      <<00019>>   03673000
  PortDSTNumPorts := PortDSTNumPorts - 1;                   <<00019>>   03674000
  release := (PortDSTNumPorts=0) land (PortDSTMaxPorts<0);  <<00019>>   03675000
  @msg := @PortCB;                                                      03676000
  release'portCB'frame;                                     <<00005>>   03677000
                                                                        03678000
Done:                                                       <<00019>>   03679000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03680000
  if aftioqx <> 0 then                                                  03681000
    Release'IOWait'index(aftioqx);                                      03682000
                                                                        03683000
  if release then RelDataSeg(PortDST);                      <<00019>>   03684000
  end;   << DeletePort >>                                               03685000
procedure DeletePortDST(portdst);                           <<00019>>   03686000
  value                 portdst;                            <<00019>>   03687000
 integer                portdst;                            <<00019>>   03688000
  option privileged, uncallable;                            <<00019>>   03689000
                                                            <<00019>>   03690000
  begin                                                     <<00019>>   03691000
                                                            <<00019>>   03692000
  exchangedb'to'PortDST;                                    <<00019>>   03693000
  if PortDSTNumPorts = 0  then                              <<00019>>   03694000
    begin                                                   <<00033>>   03695000
    exchangedb'back;                                        <<00033>>   03696000
    RelDataSeg(portdst)                                     <<00019>>   03697000
    end                                                     <<00033>>   03698000
  else                                                      <<00019>>   03699000
    begin                                                   <<00033>>   03700000
    PortDSTMaxPorts := -\PortDSTMaxPorts\;                  <<00038>>   03701000
    exchangedb'back;                                        <<00019>>   03702000
    end;                                                    <<00033>>   03703000
                                                            <<00019>>   03704000
end;                                                        <<00019>>   03705000
$page "AddPortClassName - DeletePortClassName"                          03706000
procedure GenerateDictname(ClassName,DictName);                         03707000
  byte array ClassName;                                                 03708000
  array DictName;                                                       03709000
  option privileged,uncallable,internal;                                03710000
  begin                                                                 03711000
  integer length;                                                       03712000
  byte array BDict(*) = DictName;                                       03713000
  equate PortDict'Type = 6;  << NetMgt administered >>                  03714000
                                                                        03715000
                                                                        03716000
  length := 0;                                                          03717000
  while length < 14 and ClassName(length) <> " " do                     03718000
    begin                                                               03719000
    BDict(length+2) := ClassName(length);                               03720000
    length := length +1;                                                03721000
    end;                                                                03722000
  BDict := length +1;                                                   03723000
  BDict(1) := PortDict'Type;                                            03724000
                                                                        03725000
  end;   << GenerateDictName >>                                         03726000
procedure AddPortClassName(ClassName,Plabel,Type,SubType,               03727000
                                ContextSize,MsgSize,NumSubqueues);      03728000
  value Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;           03729000
  byte array ClassName;                                                 03730000
  integer Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;         03731000
  option privileged,uncallable;                                         03732000
  begin                                                                 03733000
  integer Result;                                                       03734000
  array Name(0:7);  << massaged ClassName >>                            03735000
  integer array DictData(0:7) = Q;                                      03736000
  integer DictPlabel = DictData +0,                                     03737000
          DictType   = DictData +1,                                     03738000
          DictContext= DictData +2,                                     03739000
          DictMsgSize= DictData +3,                                     03740000
          DictNumSubqueues = DictData +4;                               03741000
                                                                        03742000
  DictPlabel := Plabel;                                                 03743000
  DictType := SubType&lsl(8) + Type.(8:8);                              03744000
  DictContext := ContextSize;                                           03745000
  DictMsgSize := MsgSize;                                               03746000
  DictNumSubqueues := NumSubqueues;                                     03747000
                                                                        03748000
  GenerateDictName(ClassName,Name);                                     03749000
  DictAdd(Name,DictData,Result);                                        03750000
                                                                        03751000
  end;   << AddPortClassName >>                                         03752000
procedure DeletePortClassName(ClassName);                               03753000
  byte array ClassName;                                                 03754000
  option privileged,uncallable;                                         03755000
  begin                                                                 03756000
  integer Result;                                                       03757000
  integer array Dummy(0:0);                                             03758000
  array Name(0:7);                                                      03759000
                                                                        03760000
  GenerateDictName(ClassName,Name);                                     03761000
  DictDelete(Name,Dummy,Result);                                        03762000
                                                                        03763000
  end;   << DeletePortClassName >>                                      03764000
$page "InitPortDST'"                                                    03765000
procedure InitPortDST'(PrimaryPool, SecondaryPool, MaxMsgSize,          03766000
                       MaxPorts, MaxSubqueues, MaxContextSize,          03767000
                       UserRegSize, UserRegOffset, PortDST');           03768000
                                                                        03769000
  value                PrimaryPool, SecondaryPool, MaxMsgSize,          03770000
                       MaxPorts, MaxSubqueues, MaxContextSize,          03771000
                       UserRegSize;                                     03772000
                                                                        03773000
  integer              PrimaryPool, SecondaryPool, MaxMsgSize,          03774000
                       MaxPorts, MaxSubqueues, MaxContextSize,          03775000
                       UserRegSize, PortDST';                           03776000
integer pointer                     UserRegOffset;                      03777000
  option privileged,uncallable;                                         03778000
                                                                        03779000
  begin                                                                 03780000
  integer UnitSize, PortSegSize, PortDST, Result;                       03781000
  integer NumPorts;                                         <<00005>>   03782000
  integer pointer msg;                                                  03783000
  equate badparm5 = 5,                                                  03784000
         dstoobig = 11,                                                 03785000
         splitstk = 10;                                                 03786000
                                                                        03787000
  turn'traps'off;                                           <<00008>>   03788000
  Result  := 0;                                                         03789000
  PortDST := 0;                                                         03790000
  Wheres'DB;                                                            03791000
  if <> then begin Result := splitstk; go to Exit; end;                 03792000
  if not (1 <= MaxSubqueues <= 16) then                                 03793000
    begin Result := badparm5; go to Exit; end;                          03794000
                                                                        03795000
  UnitSize := (SubqueuesOffset + MaxSubqueues)&LSL(1);                  03796000
  PortSegSize := PortDSTHeaderSize + UserRegSize +                      03797000
              UnitSize * MaxPorts +                         <<00005>>   03798000
              MaxMsgSize * (PrimaryPool + SecondaryPool);   <<00005>>   03799000
  if OVERFLOW then begin Result := dstoobig; go to Exit; end;<<00008>>  03800000
  if MaxContextSize > 0 then                                            03801000
    PortSegSize := PortSegSize + MaxContextSize*MaxPorts;   <<00008>>   03802000
  if OVERFLOW then begin Result := dstoobig; go to Exit; end;           03803000
                                                                        03804000
  PortDST := GetDataSeg(PortSegSize, PortSegSize);          <<00013>>   03805000
  exchangedb(PortDST);                                                  03806000
  PortSegSize := DST'Size(PortDST);                         <<00013>>   03807000
  << Init port dst header to zeros. >>                                  03808000
  @msg := 0;                                                            03809000
  msg := 0;                                                             03810000
  move msg(1) := msg,(PortSegSize-1);                       <<00013>>   03811000
                                                                        03812000
  PortDSTnum := PortDST;                                                03813000
  PortDSTSize := PortSegSize;                               <<00013>>   03814000
                                                                        03815000
  @UserRegionPointer := PortDSTHeaderSize;                              03816000
  PortDSTMaxSubqueue := MaxSubqueues - 1;                               03817000
  PortDSTMaxMsgSize := MaxMsgSize;                                      03818000
  PortDSTMaxContextSize := MaxContextSize;                              03819000
  PortDSTMaxPorts := MaxPorts;                              <<00007>>   03820000
  PortDSTUserSize := UserRegSize;                           <<00007>>   03821000
                                                                        03822000
  @msg := @UserRegionPointer(UserRegSize);                              03823000
                                                            <<00005>>   03824000
<< setup pool of Port Control Blocks >>                     <<00005>>   03825000
NumPorts := MaxPorts;                                       <<00005>>   03826000
while NumPorts > 0 do                                       <<00005>>   03827000
  begin                                                     <<00005>>   03828000
  release'PortCB'frame;                                     <<00005>>   03829000
  @msg := @msg + UnitSize;                                  <<00005>>   03830000
  NumPorts := NumPorts - 1;                                 <<00005>>   03831000
  end;                                                      <<00005>>   03832000
                                                            <<00005>>   03833000
if MaxContextSize > 0 then                                  <<00005>>   03834000
  begin   << setup pool of Context Areas >>                 <<00005>>   03835000
  NumPorts := MaxPorts;                                     <<00005>>   03836000
  while NumPorts > 0 do                                     <<00005>>   03837000
    begin                                                   <<00005>>   03838000
    release'Ctx'frame;                                      <<00005>>   03839000
    @msg := @msg + MaxContextSize;                          <<00005>>   03840000
    NumPorts := NumPorts - 1;                               <<00005>>   03841000
    end;                                                    <<00005>>   03842000
  end;                                                      <<00005>>   03843000
                                                            <<00005>>   03844000
<< setup pool of message frames >>                          <<00005>>   03845000
  while @msg <= PortDSTSize - MaxMsgSize do                 <<00005>>   03846000
    begin                                                               03847000
    release'message'frame;                                              03848000
      @msg := @msg + MaxMsgSize;                            <<00005>>   03849000
    end;                                                                03850000
                                                                        03851000
  << reserve some for the emergency pool >>                             03852000
  PoolCnt := PoolCnt - SecondaryPool;                                   03853000
  PrimaryCount := PoolCnt;                                  <<00007>>   03854000
  SecondaryCount := SecondaryPool;                          <<00007>>   03855000
                                                                        03856000
  exchangedb(0);                                                        03857000
Exit:                                                       <<00005>>   03858000
 @UserRegOffset := if Result <> 0 then Result                           03859000
              else if UserRegSize > 0 then PortDSTHeaderSize            03860000
              else 0;                                                   03861000
  PortDST' := PortDST;                                                  03862000
end; << InitPortDST' >>                                                 03863000
$page "UpSemaphore"                                                     03864000
procedure UpSemaphore(SemaphoreId);                                     03865000
  value SemaphoreId;                                                    03866000
  double SemaphoreId;                                                   03867000
  option privileged,uncallable;                                         03868000
                                                                        03869000
<< Note:  Message is really a Pascal type record.  The first >>         03870000
<<   word of message is the subqueue of the port to receive the >>      03871000
<<   message.  Note that subqueue is ignored by the DownSemaphore >>    03872000
<<   primitives.  The second word is a positive word count of the >>    03873000
<<   message length, INCLUDING the two word header. The third and >>    03874000
<<   thru the fifth words are the reply PortId and subqueue of the >>   03875000
<<   where the resource granted message should be sent. >>              03876000
  begin                                                                 03877000
comment  Algorithm:                                                     03878000
    Increment the semaphore count variable.                             03879000
    If the old count is positive, no special action is needed,          03880000
      as the resource is available.                                     03881000
    If the old count is negitive, the highest priority message          03882000
      is dequeued, and sent to the reply port and subqueue              03883000
      indicated in the message frame.                                   03884000
  ;                                                                     03885000
  double PortId = SemaphoreId;  << all defines use PortId >>            03886000
  integer pointer msg;                                                  03887000
  double pointer Dmsg = msg;                                            03888000
  integer Subqueue;                                                     03889000
                                                                        03890000
  std'decl2;   << qhead/qtail >>                                        03891000
  std'decl;                                                             03892000
  integer pointer IntPortCB = PortCB;  << declared in std'decl >>       03893000
                                                                        03894000
  exchangedb'to'PortDST;                                                03895000
  disable;                                                              03896000
  SemaphoreCnt := SemaphoreCnt +1;                                      03897000
  if > then enable  << nobody waiting for the resource >>               03898000
  else                                                                  03899000
    begin  << send a Reply message granting the resource >>             03900000
    dequeue'hipri'message;                                              03901000
    enable;                                                             03902000
    if msg(2) = PortDST then Send'Ref(Dmsg(1),msg(4),msg)               03903000
    else                                                                03904000
      begin                                                             03905000
      Send'DB(Dmsg(1),msg(4),msg);                                      03906000
      release'message'frame;                                            03907000
      end;                                                              03908000
    end;                                                                03909000
                                                                        03910000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03911000
  end;  << UpSemaphore >>                                               03912000
$page "DownSemaphore"                                                   03913000
procedure DownSemaphore'DB(SemaphoreId,Subqueue,Message);               03914000
  value SemaphoreId,Subqueue,Message;                                   03915000
  double SemaphoreId;                                                   03916000
  integer Subqueue;                                                     03917000
  integer pointer Message;                                              03918000
  option privileged,uncallable;                                         03919000
                                                                        03920000
<< Note:  Message is really a Pascal type record.  The first >>         03921000
<<   word of message is the subqueue of the port to receive the >>      03922000
<<   message.  Note that subqueue is ignored by the DownSemaphore >>    03923000
<<   primitives.  The second word is a positive word count of the >>    03924000
<<   message length, INCLUDING the two word header. The third and >>    03925000
<<   thru the fifth words are the reply PortId and Subqueue of the >>   03926000
<<   where the resource granted message should be sent. >>              03927000
  begin                                                                 03928000
                                                                        03929000
comment  Algorithm:                                                     03930000
    Get a msg buffer from the free pool.                                03931000
    Move the caller's data into the msg buffer.                         03932000
    Decrement the semaphore count variable.                             03933000
    If the new count is positive, send the reply message immeadiatly,   03934000
    If the new count is negitive, the message is queued upon the        03935000
      semaphore port, and a future UpSemaphore will dequeue it and      03936000
      send it to the reply port.                                        03937000
  ;                                                                     03938000
                                                                        03939000
  entry DownSemaphore'Q,   << secondary entry points >>                 03940000
        DownSemaphore'S,                                                03941000
        DownSemaphore'Ref;                                              03942000
                                                                        03943000
  integer array QM0array(*) = Q-0;                                      03944000
                                                                        03945000
  double PortId = SemaphoreId;                                          03946000
  integer pointer msg;                                                  03947000
  double pointer Dmsg = msg;                                            03948000
  double pointer DMessage = Message;                                    03949000
  integer Length;                                                       03950000
                                                                        03951000
  std'decl2;   << qhead/qtail >>                                        03952000
  std'decl;                                                             03953000
  integer pointer IntPortCB = PortCB;  << declared in std'decl >>       03954000
                                                                        03955000
                                                                        03956000
<< DownSemaphore'DB :    primary entry point >>                         03957000
    Length := Message(1);                                               03958000
    exchangedb'to'PortDST;                                              03959000
    if not (2 <= Length <= PortDSTMaxMsgSize) then          <<00004>>   03960000
      suddendeath(badportcall);  << +*+ >>                              03961000
                                                                        03962000
    allocate'message'frame;  << must get frame now, disabled later >>   03963000
    if @msg = 0 then suddendeath(badport);  << ICS only >>              03964000
                                                                        03965000
    disable;                                                            03966000
    SemaphoreCnt := SemaphoreCnt -1;                                    03967000
    if >= then                                                          03968000
      begin  << request granted immeadiatly >>                          03969000
      enable;                                                           03970000
      release'message'frame;  << didn't need it after all >>            03971000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             03972000
      Send'DB(DMessage(1),Message(4),Message);                          03973000
      return;   << exit from DownSemaphore >>                           03974000
      end;                                                              03975000
    << must stay disabled thru enqueue'msg >>                           03976000
    tos := CallersDB;                                                   03977000
    tos := tos + @Message;  << initializes AbsMessage >>                03978000
    GOTO FillMsg;                                                       03979000
                                                                        03980000
DownSemaphore'Q :   << secondary entry point >>                         03981000
    @Message := @Message - deltaQ;  << fixup Message addr >>            03982000
    GOTO Scontinue;                                                     03983000
                                                                        03984000
DownSemaphore'S :   << secondary entry point >>                         03985000
    << in this case, @Message is really the length of the msg >>        03986000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 03987000
    << fall through into Scontinue >>                                   03988000
                                                                        03989000
Scontinue :                                                             03990000
    << set msgdbl the hard way >>                                       03991000
    Length := QM0array(@Message +1);                                    03992000
    exchangedb'to'PortDST;                                              03993000
    if not (2 <= Length <= PortDSTMaxMsgSize) then          <<00004>>   03994000
      suddendeath(badportcall);  << +*+ >>                              03995000
                                                                        03996000
    allocate'message'frame;  << must get frame now, disabled later >>   03997000
    if @msg = 0 then suddendeath(badport);  << ICS only >>              03998000
                                                                        03999000
    disable;                                                            04000000
    SemaphoreCnt := SemaphoreCnt -1;                                    04001000
    if >= then                                                          04002000
      begin  << request granted immeadiatly >>                          04003000
      enable;                                                           04004000
      release'message'frame;  << didn't need it after all >>            04005000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             04006000
      tos := QM0array(@Message+2);  << tos := ReplyPortId;  >>          04007000
      tos := QM0array(x:=x+1);                                          04008000
      Send'Q( * ,QM0array(@Message +4),Message);                        04009000
      return;   << exit from DownSemaphore >>                           04010000
      end;                                                              04011000
    << must stay disabled thru enqueue'msg >>                           04012000
    CalcAbsQ;  << push absolute bank and address onto tos >>            04013000
    tos := tos + @Message;  << initializes AbsMessage >>                04014000
    << fall through into FillMsg >>                                     04015000
                                                                        04016000
<<>>                                                                    04017000
                                                                        04018000
FillMsg :                                                               04019000
                                                                        04020000
  << note that interrupts are still disabled >>                         04021000
  tos := AbsPortDB;     << move the data into the msg buffer >>         04022000
  tos := tos + @msg;                                                    04023000
  tos := AbsMessage;                                                    04024000
  tos := Length;                                                        04025000
  mabs5;  << perform an absolute move, and pop all parameters >>        04026000
  asmb( ddel );  << delete AbsMessage >>                                04027000
  goto enqueue'msg;                                                     04028000
                                                                        04029000
<<>>                                                                    04030000
                                                                        04031000
DownSemaphore'Ref :   << secondary entry point >>                       04032000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       04033000
  Length := Message(1);  << +*+ >>                                      04034000
  if not (2 <= Length <= PortDSTMaxMsgSize) then            <<00004>>   04035000
    suddendeath(badportcall);  << +*+ >>                                04036000
                                                                        04037000
  disable;                                                              04038000
  SemaphoreCnt := SemaphoreCnt -1;                                      04039000
  if >= then                                                            04040000
    begin  << request granted immeadiatly >>                            04041000
    enable;                                                             04042000
    Send'Ref(DMessage(1),Message(4),Message);                           04043000
    return;   << exit from DownSemaphore >>                             04044000
    end;                                                                04045000
  turn'traps'off;                                                       04046000
  pdisable;                                                             04047000
  PUSH(DB);   << simulate exchangedb'to'portdst >>                      04048000
  asmb( ddup );  << NOTE: in this path, AbsMessage is NOT allocated >>  04049000
  @msg := @Message;                                                     04050000
  << fall through into enqueue'msg >>                                   04051000
                                                                        04052000
<<>>                                                                    04053000
                                                                        04054000
enqueue'msg :                                                           04055000
  if not (0 <= Subqueue <= PortDSTMaxSubqueue) then         <<00004>>   04056000
    suddendeath(badportcall);<< +*+ >>                      <<00004>>   04057000
                                                                        04058000
  << must queue the request for UpSemaphore >>                          04059000
  << note that interrupts are still disabled >>                         04060000
  msg := 0;  << break msg link into free pool >>                        04061000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   04062000
  if @qhead <> 0 then                                                   04063000
    begin  << not the first message >>                                  04064000
    @qtail := qtail := @msg;  << queue to tail >>                       04065000
    PortCB'dbl(x) := dbl'ptrs;                                          04066000
    end                                                                 04067000
  else                                                                  04068000
    begin  << first message in the queue >>                             04069000
    tos := tos := @msg;  << queue to the front >>                       04070000
    PortCB'dbl(x) := tos;                                               04071000
    set'message'bit;  << set flags to indicate a msg is present >>      04072000
    end;                                                                04073000
  enable;                                                               04074000
                                                                        04075000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 04076000
  end;  << DownSemaphore >>                                             04077000
$page "Create'Semaphore'Port"                                           04078000
procedure Create'Semaphore'Port(PortDST, InitCount,                     04079000
                                PortId',  Result);                      04080000
  value                         PortDST, InitCount;                     04081000
  integer                       PortDST, InitCount, Result;             04082000
  double                        PortId';                                04083000
  option privileged,uncallable;                                         04084000
                                                                        04085000
  begin                                                                 04086000
  equate  badparm1 = 1,                                                 04087000
          splitstk = 10;                                                04088000
  double PortId;                                                        04089000
  logical pointer PortCB = PortId +1;                                   04090000
  integer pointer IntPortCB = PortCB;  << needed by SemaphoreCnt >>     04091000
                                                                        04092000
  integer pointer msg;                                                  04093000
                                                                        04094000
  PortId' := 0D;                                                        04095000
  CreatePort'(PortDST, 3, 0, 0, 3, PortId, Result);                     04096000
  if Result <> 0 then go to Exit;                                       04097000
  exchangedb(PortDST);                                                  04098000
  SemaphoreCnt := InitCount;                                            04099000
  PortCB'subtype := Semaphore'subtype;                                  04100000
  exchangedb(0);                                                        04101000
                                                                        04102000
 PortId' := PortId;                                                     04103000
Exit: end;                                                              04104000
                                                                        04105000
$page "FetchSeg"                                                        04106000
procedure FetchSeg(SegId,ReqType,ReplyPort,ReplySubqueue);              04107000
  value SegId,ReqType,ReplyPort,ReplySubqueue;                          04108000
  logical SegId,ReqType;                                                04109000
  double ReplyPort;                                                     04110000
  integer ReplySubqueue;                                                04111000
  option privileged,uncallable;                                         04112000
                                                                        04113000
  begin                                                                 04114000
  integer PortDST;  << dummy for exchangedb'to'PortDST >>               04115000
                                                                        04116000
  integer pointer msg;                                                  04117000
  double pointer msg'dbl = msg;                                         04118000
                                                                        04119000
  if ReqType <> %100000 then suddendeath(badportcall);  << +*+ >>       04120000
$IF  X5=OFF                                                             04121000
  iofreeze'(SegId);                                                     04122000
$IF  X5=ON                                                              04123000
  iofreeze'(double(SegId));                                             04124000
$IF                                                                     04125000
  if < then                                                             04126000
    begin   << absent, lets do it >>                                    04127000
    << Allocate a message frame in the system PortDST to >>             04128000
    << save the parameters to fetchseg until kernelc >>                 04129000
    << calls PortSeg'completor. >>                                      04130000
                                                                        04131000
    PortDST := MsgHarbTabDSTN;                                          04132000
    exchangedb'to'PortDST;                                              04133000
                                                                        04134000
    pdisable;   << force secondary pool >>                              04135000
    allocate'message'frame;                                             04136000
    if @msg = 0 then suddendeath(badport);<< +*+ >>                     04137000
    penable;                                                            04138000
                                                                        04139000
    msg'dbl := 5D;                                                      04140000
    msg'dbl(1) := ReplyPort;                                            04141000
    msg(4) := ReplySubqueue;                                            04142000
    msg(5) := SegId;                                                    04143000
    exchangedb'back;                                                    04144000
                                                                        04145000
    << Now request mem. mgr. to make it present >>                      04146000
$IF  X5=OFF                                                             04147000
    fetchioseg(SegId,0,-@msg,%100000);  << iofreeze it >>               04148000
$IF  X5=ON                                                              04149000
  fetchioseg(double(SegId),0,-@msg,%100000);                            04150000
$IF                                                                     04151000
    if = then  << Its present now >>                                    04152000
      begin   << oops, how did this happen? >>                          04153000
      PortSeg'completor(-@msg);                                         04154000
      end;                                                              04155000
    end                                                                 04156000
  else                                                                  04157000
    begin   << already present, send message now >>                     04158000
    pdisable;   << force secondary pool >>                              04159000
    tos := 3D;    << length >>                                          04160000
    tos := SegId;                                                       04161000
    Send'S(ReplyPort,ReplySubqueue,3);                                  04162000
    penable;                                                            04163000
    del;                                                                04164000
    end;                                                                04165000
                                                                        04166000
  end;   << FetchSeg >>                                                 04167000
$page "ReleaseSeg"                                                      04168000
procedure ReleaseSeg(SegId,ReqType);                                    04169000
  value SegId,ReqType;                                                  04170000
  logical SegId,ReqType;                                                04171000
  option privileged,uncallable;                                         04172000
  begin                                                                 04173000
                                                                        04174000
  if Reqtype <> %100000 then suddendeath(badportcall);  << +*+ >>       04175000
$IF  X5=OFF                                                             04176000
  iounfreeze'(SegId);                                                   04177000
$IF  X5=ON                                                              04178000
  iounfreeze'(double(SegId));                                           04179000
$IF                                                                     04180000
  if < then suddendeath(badportcall); << DST not frozen >>              04181000
                                                                        04182000
  end;   << ReleaseSeg >>                                               04183000
$page "PortSeg'completor"                                               04184000
procedure PortSeg'completor(msg'id);                                    04185000
  value msg'id;                                                         04186000
  integer msg'id;                                                       04187000
  option privileged,uncallable;                                         04188000
  begin                                                                 04189000
comment  NOTE: this procedure is called by the MPE procedure            04190000
    "awakedevice" in kernelc.  It is therefore possible to be called    04191000
    on the ICS.                                                         04192000
  ;                                                                     04193000
                                                                        04194000
  integer pointer msg = msg'id;                                         04195000
  double pointer msg'dbl = msg;                                         04196000
  double ReplyPort;                                                     04197000
  integer ReplySubqueue,                                                04198000
          ReqId;                                                        04199000
  integer PortDST = ReplyPort;                                          04200000
                                                                        04201000
  msg'id := -msg'id;  << kept as negitive to distinguish from ioqp >>   04202000
  PortDST := MsgHarbTabDSTN;                                            04203000
  exchangedb'to'PortDST;                                                04204000
                                                                        04205000
  << A message frame was allocated in the system PortDST to >>          04206000
  << save the parameters to fetchseg until kernelc >>                   04207000
  << calls PortSeg'completor. Get those parameters now. >>              04208000
                                                                        04209000
  ReplyPort := msg'dbl(1);                                              04210000
  ReplySubqueue := msg(4);                                              04211000
  ReqId := msg(5);                                                      04212000
                                                                        04213000
  << NOTE: this is basically the same code as the global define >>      04214000
  << "exchangedb'to'PortDST".  The major difference is that if >>       04215000
  << the PortDST is absent, we will switch to the system port >>        04216000
  << server process to handle the absence trap.  This and >>            04217000
  << PortTimeOut are the only instances where a PortDST may >>          04218000
  << be absent when trying to access it from the ICS. >>                04219000
                                                                        04220000
  tos := %344;  << DST 71 >>  << +*+ >>                                 04221000
  tos := abs(abs(2))&lsl(2);  << Max DST from DST(0) >> << +*+ >>       04222000
  x := PortDST&LSL(2);                                                  04223000
  if not (tos <= x <= tos) then suddendeath(wrongDST);  << +*+ >>       04224000
  disable;                                                              04225000
  x := dst(x);  << set cond. code >>                                    04226000
  if < then                                                             04227000
    begin  << absent >>                                                 04228000
    on'ics;  << tos = true if executing on the ics >>                   04229000
    if tos then                                                         04230000
      begin << on the ICS, or called pdisabled >>                       04231000
      << switch to system port server, where absence trap ok >>         04232000
      enable;                                                           04233000
      tos := 3D;   << Length >>                                         04234000
      tos := -msg'id;                                                   04235000
      << Uses secondary pool since pdisabled >>                         04236000
      Send'S(FindProcessPort(SysPort'pin),1,3);                         04237000
      asmb( ddel,del );                                                 04238000
      exchangedb'back;   << from MsgHarbTabDSTN  >>                     04239000
      return;   << exit from PortSeg'completor >>                       04240000
      end;                                                              04241000
    end;                                                                04242000
  enable;                                                               04243000
                                                                        04244000
  release'message'frame;                                                04245000
  exchangedb'back;                                                      04246000
                                                                        04247000
  tos := 3D;  << length >>                                              04248000
  tos := ReqId;                                                         04249000
  Send'S(ReplyPort,ReplySubqueue,3);                                    04250000
  del;                                                                  04251000
                                                                        04252000
  end;  << PortSeg'completor >>                                         04253000
$page "StartTimer"                                                      04254000
$PAGE "UpdateHeadTime"                                                  04255000
comment: UpdateHeadTime --- Update the head delta time,                 04256000
                            save the current time into                  04257000
                            LASTSTARTTIME.                              04258000
;                                                                       04259000
procedure UpdateHeadTime;                                               04260000
option privileged, uncallable, internal;                                04261000
begin                                                                   04262000
  double elapsedtime,                                                   04263000
         rollover := 86400000D;  << 24 hours in msec >>     <<00025>>   04264000
  integer pointer TRL = 10;      << timer request list >>               04265000
  double pointer timeheaddbl = timehead;                                04266000
  equate dtime = 5; << offset to time of day in TRL >>                  04267000
  define timeheaddelta = timeheaddbl(deltatime'index)#;                 04268000
                                                                        04269000
  tos := TRL(dtime);             << get the current time >>             04270000
  tos := TRL(x := x+1);                                                 04271000
  if TimeHead <> 0 then          << update head delta time >>           04272000
    begin                                                               04273000
      asmb( ddup );                                                     04274000
      tos := tos - last'start'time;                                     04275000
      if < then tos := tos + rollover;                                  04276000
      elapsedtime := tos;                                               04277000
      timeheaddelta := timeheaddelta - elapsedtime;                     04278000
    end;                                                                04279000
  last'start'time := tos;        << save the current time >>            04280000
end;                                                                    04281000
$PAGE "StartTimer"                                                      04282000
double procedure StartTimer(DeltaTime, ReplyPort,                       04283000
                            ReplySubqueue, ReqId);                      04284000
value                       DeltaTime, ReplyPort,                       04285000
                            ReplySubqueue ,ReqId;                       04286000
double                      DeltaTime, ReplyPort;                       04287000
integer                     ReplySubqueue, ReqId;                       04288000
option privileged,uncallable;                                           04289000
begin                                                                   04290000
  double                                                                04291000
    PortId = ReplyPort,                                                 04292000
    TimerId = StartTimer,                                               04293000
    one'day := 86400000D;                                   <<00045>>   04294000
  integer TimerDST = TimerId;                                           04295000
  integer pointer TimerCB = TimerId + 1;                                04296000
  double pointer TimerCB'dbl = TimerCB;                                 04297000
  integer pointer msg = TimerCB; << for allocate'message'frame >>       04298000
                                                                        04299000
  integer pointer prev,                                                 04300000
                  next;                                                 04301000
  double pointer prev'dbl = prev,                                       04302000
                 next'dbl = next;                                       04303000
  define next'deltatime = next'dbl(deltatime'index)#;                   04304000
  integer oldhead;                                                      04305000
                                                                        04306000
  std'decl;                                                             04307000
  turn'traps'off;                                                       04308000
                                                                        04309000
  if DeltaTime <= 0D or DeltaTime >= one'day then           <<00045>>   04310000
    suddendeath (badportcall);                                          04311000
                                                                        04312000
  tos := deltatime;            << round delta time up to >>             04313000
  tos := 100D;                 << a 100 msec interval    >>             04314000
  asmb(ddiv );                                                          04315000
  asmb( dtst, ddel );          << delete remainder       >>             04316000
  if <> then tos := tos + 1D;                                           04317000
  tos := 100D;                                                          04318000
  asmb( dmul );                                                         04319000
  deltatime := tos;                                                     04320000
                                                                        04321000
  TimerDST := PortDST;                                                  04322000
  exchangedb'to'PortDST; << DB to ReplyPortDST >>                       04323000
  if PortDSTMaxMsgSize < TimerLength then << +*+ >>                     04324000
    suddendeath(badportcall); << +*+ >>                                 04325000
                                                                        04326000
  allocate'message'frame; << sets TimerCB via msg >>                    04327000
  if @msg = 0 then suddendeath(badport); << ICS only >>                 04328000
                                                                        04329000
  TimerCB'length := TimerLength;                                        04330000
  TimerCB'reqid := ReqId;                                               04331000
  TimerCB'replyport := ReplyPort;                                       04332000
  TimerCB'subqueue := ReplySubqueue;                                    04333000
                                                                        04334000
 << insert element in time order >>                                     04335000
  disable; << needed because of ICS ports >>                            04336000
  UpdateHeadTime;                                                       04337000
  oldhead := TimeHead;                                                  04338000
  @prev := @TimeHead;                                                   04339000
  @next := TimeHead;                                                    04340000
                                                                        04341000
  while <> and (next'deltatime <= DeltaTime) do                         04342000
    begin << find place in list >>                                      04343000
    deltatime := deltatime - next'deltatime;                            04344000
    @prev := @next;                                                     04345000
    @next := next;                                                      04346000
    end;                                                                04347000
                                                                        04348000
 << insert it >>                                                        04349000
  TimerCB := @next; << link new to rest of list >>                      04350000
  prev := @TimerCB;                                                     04351000
  TimerCB'deltatime := deltatime;                                       04352000
  if @next <> 0 then                                                    04353000
    next'deltatime := next'deltatime - deltatime;                       04354000
                                                                        04355000
  if oldhead <> TimeHead then                                           04356000
    begin << new head entry, start a new MPE timer >>                   04357000
    if TimeTRLX <> 0 then aborttimereq(TimeTRLX);                       04358000
    @next := TimeHead; << for addressing deltatime >>                   04359000
    TimeTRLX := timereq(%13,TimerDST,next'deltatime);                   04360000
    end;                                                                04361000
  enable;                                                               04362000
                                                                        04363000
  exchangedb'back; << CallersDB/AbsPortDB is popped >>                  04364000
  end;  << StartTimer >>                                                04365000
$PAGE "AbortTimer"                                                      04366000
procedure AbortTimer(TimerId);                                          04367000
  value TimerId;                                                        04368000
  double TimerId;                                                       04369000
  option privileged,uncallable;                                         04370000
                                                                        04371000
  begin                                                                 04372000
  integer TimerDST = TimerId;                                           04373000
  integer pointer TimerCB = TimerId +1;                                 04374000
  double pointer TimerCB'dbl = TimerCB;                                 04375000
  integer pointer msg = TimerCB; << for release'message'frame >>        04376000
                                                                        04377000
  integer Subqueue;                                                     04378000
  integer pointer prev,                                                 04379000
                  next;                                                 04380000
  double pointer prev'dbl = prev,                                       04381000
                 next'dbl = next;                                       04382000
  define next'deltatime = next'dbl(deltatime'index)#;                   04383000
  integer oldhead;  << data is of pointer type >>                       04384000
                                                                        04385000
  double PortId;                                                        04386000
  std'decl2;                                                <<00038>>   04387000
  std'decl;                                                 <<00038>>   04388000
                                                                        04389000
  PortDST := TimerDST;                                                  04390000
  exchangedb'to'PortDST; << DB to TimerDST >>                           04391000
                                                                        04392000
  disable; << needed because of ICS ports >>                            04393000
  if TimerCB'length = TimerLength then                                  04394000
    begin  << timer hasn't popped, remove from timer list >>            04395000
    oldhead := TimeHead;                                                04396000
    if = then suddendeath(badport); << +*+ >>                           04397000
    @prev := @TimeHead;                                                 04398000
    while prev <> @TimerCB do                                           04399000
      begin << find request in list >>                                  04400000
      @prev := prev;                                                    04401000
      if = then suddendeath(badport); << +*+ >>                         04402000
      end;                                                              04403000
    if @TimerCB = TimeHead then UpdateHeadTime;                         04404000
    prev := TimerCB;  << delink request >>                              04405000
    if <> then                                                          04406000
      begin << removed from middle, adjust time of successor >>         04407000
      @next := TimerCB;                                                 04408000
      next'deltatime := next'deltatime + TimerCB'deltatime;             04409000
      end;                                                              04410000
    if oldhead <> TimeHead then                                         04411000
      begin << new head entry, restart MPE timer >>                     04412000
      aborttimereq(TimeTRLX);                                           04413000
      @next := TimeHead;                                                04414000
      TimeTRLX := if = then 0 << no more timers >>                      04415000
        else timereq(%13,TimerDST,next'deltatime);                      04416000
      end;                                                              04417000
    end                                                                 04418000
  else                                                                  04419000
    begin << already popped, queued to a port >>                        04420000
    if TimerCB'length <> TimerPoppedLen then << +*+ >>                  04421000
      suddendeath(badport); << +*+ >>                                   04422000
    PortId := TimerCB'replyport;                                        04423000
    if PortDST <> PortDSTnum then suddendeath(badport); << +*+ >>       04424000
                                                                        04425000
    Subqueue := TimerCB'subqueue;                                       04426000
    dbl'ptrs := PortCB'dbl(Subqueue + Subqueuesoffset);                 04427000
    @next := @prev := @qhead;                                           04428000
    if = then suddendeath(badport); << +*+ >>                           04429000
    while @next <> @TimerCB do                                          04430000
      begin << find request in list >>                                  04431000
      @prev := @next;                                                   04432000
      @next := next;                                                    04433000
      if = then suddendeath(badport); << +*+ >>                         04434000
      end;                                                              04435000
                                                                        04436000
   << delink found entry >>                                             04437000
    if @prev <> @next                                                   04438000
      then prev := next  << not at head of queue >>                     04439000
      else @prev := @qhead := next; << remove head entry >>             04440000
    if @qtail = @next then                                              04441000
      @qtail := @prev; << removed last in list >>                       04442000
    PortCB'dbl(Subqueue + Subqueuesoffset) := dbl'ptrs;                 04443000
    if @qhead = 0 then                                                  04444000
      reset'message'bit;                                                04445000
    end;                                                                04446000
  enable;                                                               04447000
                                                                        04448000
  TimerCB'length := 2; << convert to null message >>                    04449000
  release'message'frame;                                                04450000
  exchangedb'back; << CallersDB/AbsPortDB is popped >>                  04451000
  end;  << AbortTimer >>                                                04452000
$PAGE "PortTimeOut"                                                     04453000
procedure PortTimeOut(TimerDST);                                        04454000
  value TimerDST;                                                       04455000
  integer TimerDST;                                                     04456000
  option privileged,uncallable;                                         04457000
  begin                                                                 04458000
comment  NOTE: this procedure is called by the MPE procedure            04459000
    "oldtick" in hardres.  It is therefore callable on the              04460000
    ICS.                                                                04461000
  ;                                                                     04462000
                                                                        04463000
  integer pointer TimerCB;                                              04464000
  double pointer TimerCB'dbl = TimerCB;                                 04465000
  double pointer TimeHead'dbl = TimeHead;                               04466000
  define DeltaTime = TimeHead'dbl(deltatime'index)#;                    04467000
  double OldDelta;                                                      04468000
                                                                        04469000
                                                                        04470000
  double PortId;                                                        04471000
  integer Subqueue;                                                     04472000
                                                                        04473000
 << NOTE: this is basically the same code as the global define >>       04474000
 << "exchangedb'to'PortDST".  The major difference is that if >>        04475000
 << the PortDST is absent, we will switch to the system port >>         04476000
 << server process to handle the absence trap.  This and >>             04477000
 << PortSeg'completor are the only instances where a PortDST may >>     04478000
 << be absent when trying to access it from the ICS. >>                 04479000
                                                                        04480000
  tos := %344; << DST 71 >> << +*+ >>                                   04481000
  tos := abs(abs(2))&lsl(2); << Max DST from DST(0) >><< +*+ >>         04482000
  x := TimerDST&LSL(2);                                                 04483000
  if not (tos <= x <= tos) then suddendeath(wrongDST); << +*+ >>        04484000
  disable;                                                              04485000
  tos := dst(x);                                                        04486000
  if < then                                                             04487000
    begin << absent >>                                                  04488000
    pdisable; << on'ics needs at least on pdisable in effect >>         04489000
    on'ics; << tos = true if executing on the ics >>                    04490000
    if tos then                                                         04491000
      begin<< on the ICS, or called pdisabled >>                        04492000
     << switch to system port server, where absence trap ok >>          04493000
      enable;                                                           04494000
      tos := 3D;  << Length >>                                          04495000
      tos := TimerDST;                                                  04496000
     << Uses secondary pool since pdisabled >>                          04497000
      Send'S(FindProcessPort(SysPort'pin),2,3);                         04498000
  << asmb( ddel,ddel ); >> << msg plus dst(0) >>                        04499000
      penable;                                                          04500000
      return;  << exit from PortTimeOut >>                              04501000
      end                                                               04502000
    else                                                                04503000
      begin << absent, and ok to cause a makepresent >>                 04504000
      penable;                                                          04505000
      x := TimerDST&LSL(2);  << on'ics alters X reg. >>                 04506000
      do begin                                                          04507000
        del;                                                            04508000
$IF  X5=OFF                                                             04509000
        queueonsegment(TimerDST.(2:14));                                04510000
$IF  X5=ON                                                              04511000
        queueonsegment(double(TimerDST.(2:14)));                        04512000
$IF                                                                     04513000
        tos := dst(x);                                                  04514000
      end until > ;                                                     04515000
      end; << DST now present >>                                        04516000
    end; << absent case >>                                              04517000
  tos.(2:1) := true; << set ref. bit >>                                 04518000
  dst(x) := tos;                                                        04519000
  pdisable;                                                             04520000
 << stay inturrupt disabled, until Tick loop >>                         04521000
                                                                        04522000
  tos := dst(x:=x+2); << bank >>                                        04523000
  tos := dst(x:=x+1); << addr >>                                        04524000
  asmb( ddup );                                                         04525000
  asmb( xchd );                                                         04526000
  if TimerDST <> PortDSTnum then suddendeath(wrongDST); << +*+ >>       04527000
                                                                        04528000
  aborttimereq(TimeTRLX);                                               04529000
  TimeTRLX := 0;                                                        04530000
                                                                        04531000
  UpdateHeadTime; << correct current delta. MIGHT BE NEGATIVE >>        04532000
                                                                        04533000
  do begin << process all Ticks = present time >>                       04534000
    OldDelta := Deltatime;  << save current delta time >>               04535000
    @TimerCB := TimeHead;                                               04536000
    TimeHead := TimerCB; << delink entry >>                             04537000
    if <> then                                              <<00026>>   04538000
      DeltaTime:= DeltaTime + OldDelta; << update next delta time >>    04539000
    enable;                                                             04540000
    PortId := TimerCB'replyport;                                        04541000
    Subqueue := TimerCB'subqueue;                                       04542000
    TimerCB'length := TimerPoppedLen; << hide ReplyPort & Subqueue>>    04543000
    Send'Ref(PortId,Subqueue,TimerCB);                                  04544000
    disable;                                                            04545000
  end until TimeHead = 0 or DeltaTime > 0D;                             04546000
                                                                        04547000
  if TimeHead <> 0 then                                                 04548000
    begin                                                               04549000
    TimeTRLX := timereq(%13,TimerDST,Deltatime);                        04550000
    end;                                                                04551000
  enable;                                                               04552000
                                                                        04553000
  exchangedb'back; << CallersDB/AbsPortDB is popped >>                  04554000
  end;  << PortTimeOut >>                                               04555000
$page "Create'Signal'Port"                                              04556000
procedure SignalPort'server(PortId,Context,Message);                    04557000
  value PortId,Context,Message;                                         04558000
  double PortId;                                                        04559000
  integer pointer Context,Message;                                      04560000
  option privileged,uncallable,internal;                                04561000
  begin                                                                 04562000
  logical pointer PortCB = PortId +1;                                   04563000
  double pointer PortCB'dbl = PortCB;                                   04564000
  double pointer dblcontext = context;                                  04565000
  integer Subqueue;                                                     04566000
                                                                        04567000
  Subqueue := Message << (0) >>;                                        04568000
  << the following should probably be replaced >>                       04569000
  PortDisable(PortId);                                                  04570000
  Replace'Ref(PortId,Subqueue,Message);                                 04571000
  PortMaskEnable(PortId,1&csr(Subqueue +1));  << Re-enable mask >>      04572000
                                                                        04573000
  tos := 4D;  << Subqueue and Length >>                                 04574000
  tos := PortId;   << PortId must be sent, indicating data avail. >>    04575000
  Send'S(homeport, homesubqueue, 4);                                    04576000
                                                                        04577000
  end;                                                                  04578000
                                                                        04579000
procedure Create'Signal'Port( PortDST, DestPortId,                      04580000
                              DestSubqueue, PortId', Result);           04581000
  value    PortDST, DestPortId, DestSubqueue;                           04582000
  integer  PortDST, DestSubqueue, Result;                               04583000
  double   DestPortId, PortId';                                         04584000
  option privileged,uncallable;                                         04585000
                                                                        04586000
  begin                                                                 04587000
  equate badparm1 = 1,                                                  04588000
         splitstk = 10;                                                 04589000
  double PortId;                                                        04590000
  logical pointer PortCB = PortId +1, context;                          04591000
  double pointer PortCB'dbl = PortCB, dblcontext = context;             04592000
                                                                        04593000
  integer pointer msg;                                                  04594000
                                                                        04595000
  PortId' := 0D;                                                        04596000
  CreatePort'(PortDST, 3, @SignalPort'server, 0, 3, PortId, Result);    04597000
  if Result <> 0 then go to Exit;                                       04598000
  exchangedb(PortDST);                                                  04599000
  << Initialize the PortCB home port area >>                            04600000
  @context := PortCB'context;                                           04601000
  homeport := DestPortId;                                               04602000
  homesubqueue := DestSubqueue;                                         04603000
  exchangedb(0);                                                        04604000
  PortId' := PortId;                                                    04605000
                                                                        04606000
Exit:  end;   << Create'Signal'Port >>                                  04607000
$page "IOWait Ports - EnableIOWaitPort"                                 04608000
procedure EnableIOWaitPort(IOWait'Index);                               04609000
  value IOWait'Index;                                                   04610000
  integer IOWait'Index;                                                 04611000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 04612000
  begin                                                                 04613000
                                                                        04614000
  double PortId;                                                        04615000
  integer pointer Context;                                              04616000
  std'decl;                                                             04617000
                                                                        04618000
  equate user'interrupt = 0,                                            04619000
         file'soft'int = 1,                                             04620000
         awaken'process = 0;                                            04621000
                                                                        04622000
  << DB must be at stack DB >>                                          04623000
  tos := @PortId;  << find PortId in IOWaitDST >>                       04624000
  tos := IOWait'PortId'DST;                                             04625000
  tos := IOWait'Index;                                                  04626000
  tos := 2;   << PortId is a double word >>                             04627000
  asmb( mfds 4 );                                                       04628000
                                                                        04629000
  exchangedb'to'PortDST;                                                04630000
  @Context := PortCb'context;                                           04631000
                                                                        04632000
  disable;                                                              04633000
  PortCB'enabled := true;                                               04634000
  tos := PortCB'dbl;   << get both flags and mask >>                    04635000
  asmb( and,del );                                                      04636000
  if <> and not PortCB'active <<and PortCB'enabled>> then               04637000
    begin  << simulate running the port procedure >>                    04638000
    tos := @IOWaitPort'server;  << load required Plabel >>              04639000
    if tos <> PortCB'server'plabel then                                 04640000
      suddendeath(badport);                                             04641000
                                                                        04642000
    << This code is essentially duplicated from PortDispatcher >>       04643000
    << and IOWaitPort'server procedures for performance reasons >>      04644000
    PortCB'active := true;                                              04645000
    enable;                                                             04646000
                                                                        04647000
    if IOWait'softint'plabel = 0 then                                   04648000
      awake(integer(PortCB'pin)*pcbsize,msgwaitcode,nowait)             04649000
    else                                                                04650000
      begin  << must invoke use's soft interrupt routine >>             04651000
      tos := IOWait'aftioqx;   << used for dump analysis only >>        04652000
      tos := IOWait'aftindex;                                           04653000
      causesoftint(PortCB'pin,user'interrupt,file'soft'int,             04654000
                     IOWait'softint'plabel,2,awaken'process);           04655000
      end;                                                              04656000
    disable;                                                            04657000
    PortCB'active := false;                                             04658000
    PortCB'enabled := false;                                            04659000
    end;                                                                04660000
                                                                        04661000
  tos := PortCb'dbl;   << get both flags and mask >>                    04662000
  enable;                                                               04663000
  asmb( and,del );                                                      04664000
  if <>                                                                 04665000
    then cc := ccl                                                      04666000
    else cc := cce;                                                     04667000
                                                                        04668000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 04669000
                                                                        04670000
  end;   << EnableIOWaitPort >>                                         04671000
$page "IOWait Ports - DisableIOWaitPort"                                04672000
procedure DisableIOWaitPort(IOWait'Index);                              04673000
  value IOWait'Index;                                                   04674000
  integer IOWait'Index;                                                 04675000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 04676000
  begin                                                                 04677000
                                                                        04678000
  double PortId;                                                        04679000
  std'decl;                                                             04680000
                                                                        04681000
  << DB must be at stack DB >>                                          04682000
  tos := @PortId;  << find PortId in IOWaitDST >>                       04683000
  tos := IOWait'PortId'DST;                                             04684000
  tos := IOWait'Index;                                                  04685000
  tos := 2;   << PortId is a double word >>                             04686000
  asmb( mfds 4 );                                                       04687000
                                                                        04688000
  exchangedb'to'PortDST;                                                04689000
                                                                        04690000
  disable;                                                              04691000
  PortCB'enabled := false;                                              04692000
  tos := PortCB'dbl;   << get both flags and mask >>                    04693000
  enable;                                                               04694000
  asmb( and,del );                                                      04695000
  if <>                                                                 04696000
    then cc := ccl                                                      04697000
    else cc := cce;                                                     04698000
                                                                        04699000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 04700000
                                                                        04701000
  end;   << DisableIOWaitPort >>                                        04702000
$page "IOWait Ports - IOWaitDispatcher"                                 04703000
procedure IOWaitDispatcher(IOWait'Index);                               04704000
  value IOWait'Index;                                                   04705000
  integer IOWait'Index;                                                 04706000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 04707000
  begin                                                                 04708000
                                                                        04709000
  double PortId;                                                        04710000
  integer pointer Message,                                              04711000
                  msg;                                                  04712000
  integer pointer Context,                                              04713000
                  pxfile,                                   <<00009>>   04714000
                  aft;                                                  04715000
  integer ioqx,                                                         04716000
          fnum,   << aft index >>                                       04717000
          dl,     << DL Register value >>                               04718000
          NewCount;                                                     04719000
  logical pmap;                                                         04720000
  integer move'target;  << need local copies of IOWAIT's ref. parms >>  04721000
                                                                        04722000
  integer Old'DST,                                                      04723000
          Subqueue,                                                     04724000
          msg'size,                                                     04725000
          context'ptr,                                                  04726000
          context'size;                                                 04727000
  integer S0 = S-0,                                                     04728000
          S1 = S-1;                                                     04729000
  integer pointer PS0 = S-0;                                            04730000
                                                                        04731000
  integer deltaQ = Q-0;                                                 04732000
  integer array QM0(*) = Q-0;                                           04733000
  equate Q'status = -1;  << status reg. in stack marker >>              04734000
  integer pointer iowait'stackmarker;                                   04735000
  equate iowait'funcvalue = -9,   << IOWAIT parameters >>               04736000
         iowait'fnum = -8,                                              04737000
         iowait'target = -7,                                            04738000
         iowait'tcount = -6,                                            04739000
         iowait'cstation = -5,                                          04740000
         iowait'pmap = -4;                                              04741000
                                                                        04742000
  std'decl2;   << qhead/qtail >>                                        04743000
  std'decl;                                                             04744000
                                                                        04745000
  Old'DST := exchangedb(0);                                             04746000
  tos := @PortId;  << find PortId in IOWaitDST >>                       04747000
  tos := IOWait'PortId'DST;                                             04748000
  tos := IOWait'Index;                                                  04749000
  if < then tos := -tos;   << soft int. loads -Index >>                 04750000
  tos := 2;   << PortId is a double word >>                             04751000
  asmb( mfds 4 );                                                       04752000
                                                                        04753000
  exchangedb'to'PortDST;                                                04754000
                                                                        04755000
  disable;                                                              04756000
  PortCB'active := true;  << mutual exclusion semaphore >>              04757000
  dequeue'hipri'message;                                                04758000
  enable;                                                               04759000
  msg'size := msg(msg'length);                                          04760000
  context'ptr := PortCB'context;                                        04761000
  context'size := PortDSTMaxContextSize;                                04762000
                                                                        04763000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 04764000
                                                                        04765000
  << make room for data structures on the stack >>                      04766000
  @Message := @S0 +1;                                                   04767000
  tos := msg'size;                                                      04768000
  asmb( adds 0 );  << allocate space for messages >>                    04769000
                                                                        04770000
  tos := @Message;   << copy message frame to stack >>                  04771000
  tos := PortDST;                                                       04772000
  tos := @msg;                                                          04773000
  tos := msg'size;                                                      04774000
  asmb( mfds 4 );                                                       04775000
                                                                        04776000
  << copy the context area to the stack >>                              04777000
  @Context := @S0 +1;                                                   04778000
  tos := context'size;                                                  04779000
  asmb( adds 0 );  << allocate space for context area >>                04780000
                                                                        04781000
  tos := @Context;  << move context to stack >>                         04782000
  tos := PortDST;                                                       04783000
  tos := context'ptr;                                                   04784000
  tos := context'size;                                                  04785000
  asmb( mfds 4 );                                                       04786000
                                                                        04787000
  << make copies of IOWAIT's parameters >>                              04788000
  @iowait'stackmarker := @QM0(-deltaQ);                                 04789000
  pmap := iowait'stackmarker(iowait'pmap);                              04790000
                                                                        04791000
  tos := @iowait'stackmarker(iowait'funcvalue);  << upper bounds >>     04792000
  tos := iowait'stackmarker(iowait'fnum);                               04793000
  tos := Old'DST;                                                       04794000
  if not pmap.(13:1)                                                    04795000
    then tos := 0D   << target not specified >>                         04796000
    else                                                                04797000
      begin  << target specified, specify bounds >>                     04798000
      tos := iowait'stackmarker(iowait'target);                         04799000
      if Old'DST = 0 then                                               04800000
        begin  << stack DB, use IOWAIT marker as limit >>               04801000
        tos := @iowait'stackmarker(iowait'funcvalue) - S0;              04802000
        end                                                             04803000
      else                                                              04804000
        begin  << DB at an XDS, use DST length as limit >>              04805000
        tos := DST'Size(Old'DST) - S0;                      <<00009>>   04806000
        end;                                                            04807000
      end;                                                              04808000
  if not pmap.(14:1) then tos := 0  << tcount not specified >>          04809000
  else if Old'DST = 0 then                                              04810000
    begin  << easy, user called IOWAIT with DB at stack >>              04811000
    tos := iowait'stackmarker(iowait'tcount);                           04812000
    tos := PS0;                                                         04813000
    asmb( delb );                                                       04814000
    end                                                                 04815000
  else                                                                  04816000
    begin  << a little harder, user called with DB at an XDS >>         04817000
    tos := @move'target;                                                04818000
    tos := Old'DST;                                                     04819000
    tos := iowait'stackmarker(iowait'tcount);                           04820000
    tos := 1;  << move count >>                                         04821000
    asmb( mfds 4 );                                                     04822000
                                                                        04823000
    tos := move'target;  << tcount >>                                   04824000
    end;                                                                04825000
                                                                        04826000
  if not pmap.(15:1) then tos := 0  << cstation not specified >>        04827000
  else if Old'DST = 0 then                                              04828000
    begin  << easy, user called IOWAIT with DB at stack >>              04829000
    tos := iowait'stackmarker(iowait'cstation);                         04830000
    tos := PS0;                                                         04831000
    asmb( delb );                                                       04832000
    end                                                                 04833000
  else                                                                  04834000
    begin  << a little harder, user called with DB at an XDS >>         04835000
    tos := @move'target;                                                04836000
    tos := Old'DST;                                                     04837000
    tos := iowait'stackmarker(iowait'cstation);                         04838000
    tos := 1;  << move count >>                                         04839000
    asmb( mfds 4 );                                                     04840000
                                                                        04841000
    tos := move'target;  << cstation >>                                 04842000
    end;                                                                04843000
                                                                        04844000
  tos := 2;   << CondCode >>                                            04845000
  tos := pmap;                                                          04846000
                                                                        04847000
  << actually run the server here >>                                    04848000
  tos := PortId;                                                        04849000
  tos := @Context + IOWait'usercontext;                                 04850000
  tos := @Message;                                                      04851000
  tos := IOWait'portplabel;                                             04852000
  asmb( pcal 0 );                                                       04853000
                                                                        04854000
  del;    << delete pmap >>                                             04855000
  if S0.(6:2) = 1 then       << if CCL >>                   <<00009>>   04856000
    begin                                                               04857000
    push(dl);                                               <<00009>>   04858000
    @pxfile := tos - PS0(-3);                               <<00009>>   04859000
    last'error'no := S0.(0:8);                              <<00009>>   04860000
    end;                                                    <<00009>>   04861000
  iowait'stackmarker(Q'status).(6:2) := tos;  << "return" CondCode >>   04862000
  if not pmap.(15:1) then                                               04863000
    asmb(del)        << delete zero for cstation >>                     04864000
  else               << cstation specified       >>                     04865000
    if Old'DST = 0 then                                                 04866000
      begin  << easy, user called IOWAIT with DB at stack >>            04867000
      tos := iowait'stackmarker(iowait'cstation);                       04868000
      PS0 := S1;                                                        04869000
      ddel;  << addr. and cstation >>                                   04870000
      end                                                               04871000
    else                                                                04872000
      begin  << a little harder, user called with DB at an XDS >>       04873000
      move'target := tos;   << cstation >>                              04874000
      tos := Old'DST;                                                   04875000
      tos := iowait'stackmarker(iowait'cstation);                       04876000
      tos := @move'target;                                              04877000
      tos := 1;  << move count >>                                       04878000
      asmb( mtds 4 );                                                   04879000
      end;                                                              04880000
                                                                        04881000
  if not pmap.(14:1) then                                               04882000
    asmb(del)        << delete zero for tcount   >>                     04883000
  else               << tcount specified         >>                     04884000
    if Old'DST = 0 then                                                 04885000
      begin  << easy, user called IOWAIT with DB at stack >>            04886000
      tos := iowait'stackmarker(iowait'tcount);                         04887000
      PS0 := S1;                                                        04888000
      ddel;  << addr. and tcount >>                                     04889000
      end                                                               04890000
    else                                                                04891000
      begin  << a little harder, user called with DB at an XDS >>       04892000
      move'target := tos;   << tcount >>                                04893000
      tos := Old'DST;                                                   04894000
      tos := iowait'stackmarker(iowait'tcount);                         04895000
      tos := @move'target;                                              04896000
      tos := 1;  << move count >>                                       04897000
      asmb( mtds 4 );                                                   04898000
      end;                                                              04899000
                                                                        04900000
  asmb( subs 5 );  << delete MaxLength, BuffOffset, BuffDST, >>         04901000
                   << AFTIndex, and StackUpperBounds from TOS >>        04902000
                                                                        04903000
  << put the copy of the context back in the PortDST >>                 04904000
  tos := PortDST;                                                       04905000
  tos := context'ptr + IOWait'usercontext;                              04906000
  tos := @Context + IOWait'usercontext;                                 04907000
  tos := context'size - IOWait'usercontext;                             04908000
  asmb( mtds 4 );                                                       04909000
                                                                        04910000
  exchangedb'to'PortDST;                                                04911000
  release'message'frame;                                                04912000
                                                                        04913000
  @Context := context'ptr;                                              04914000
  fnum := IOWait'aftindex;                                              04915000
  ioqx := if IOWait'softint'plabel <> 0                                 04916000
            then softintpend                                            04917000
            else IOWait'aftioqx;                                        04918000
  disable;                                                              04919000
  PortCB'active := false;  << mutual exclusion no longer needed >>      04920000
  IOWait'count := IOWait'count -1;                                      04921000
  enable;                                                               04922000
  NewCount := IOWait'count;                                             04923000
  << Note: IOWait port procedures may NOT call TerminatePort >>         04924000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 04925000
                                                                        04926000
  if NewCount > 0 then                                                  04927000
    begin  << set ioqx into aft for IOWAITs use >>                      04928000
    push(dl);  dl := tos;                                               04929000
    @aft := -fnum*aftsize + dl - aft'base;                              04930000
    aft(to'ioqx) := ioqx;                                               04931000
    if ioqx = softintpend then PortEnable(PortId);                      04932000
    end;                                                                04933000
                                                                        04934000
  if Old'DST <> 0 then exchangedb(Old'DST);                             04935000
                                                                        04936000
  end;  << IOWaitDispatcher >>                                          04937000
$page "IOWait Ports - IOWaitPort'server"                                04938000
                                                                        04939000
procedure IOWaitPort'server(PortId,Context,Message);                    04940000
  value PortId,Context,Message;                                         04941000
  double PortId;                                                        04942000
  integer pointer Context,Message;                                      04943000
  option privileged,uncallable,internal;                                04944000
  begin                                                                 04945000
  logical pointer PortCB = PortId +1;                                   04946000
  double pointer PortCB'dbl = PortCB;                                   04947000
  integer Subqueue;                                                     04948000
                                                                        04949000
  equate user'interrupt = 0,                                            04950000
         port'soft'int = 2,                                             04951000
         awaken'process = 0;                                            04952000
                                                                        04953000
  << NOTE: IOWAIT software interrupts share code with message >>        04954000
  << files in "PSEUDOINT".  PseudoInt calls "FCPREPAFT" to >>           04955000
  << set the completion status of -1 in the AFT. >>                     04956000
                                                                        04957000
  Subqueue := Message << (0) >>;                                        04958000
  << the following should probably be replaced >>                       04959000
  PortDisable(PortId);                                                  04960000
  Replace'Ref(PortId,Subqueue,Message);                                 04961000
  PortMaskEnable(PortId,1&csr(Subqueue +1));  << Re-enable mask >>      04962000
                                                                        04963000
  if IOWait'softint'plabel = 0 then                                     04964000
    awake(integer(PortCB'pin)*pcbsize,msgwaitcode,nowait)               04965000
  else                                                                  04966000
    begin  << must invoke use's soft interrupt routine >>               04967000
    tos := IOWait'aftioqx;   << pseudoint stores into aft >>            04968000
    tos := IOWait'aftindex;                                             04969000
    causesoftint(PortCB'pin,user'interrupt,port'soft'int,               04970000
                   IOWait'softint'plabel,2,awaken'process);             04971000
    end;                                                                04972000
  end;  << IOWaitPort'server >>                                         04973000
$page "IOWait Ports - CreateIOWaitPort"                                 04974000
double procedure CreateIOWaitPort(ClassName,PortDST,NewFrames);         04975000
  value ClassName,PortDST,NewFrames;                                    04976000
  byte pointer ClassName;                                               04977000
  integer PortDST,NewFrames;                                            04978000
  option privileged,uncallable;                                         04979000
  begin                                                                 04980000
  double PortId = CreateIOWaitPort;                                     04981000
  logical pointer PortCB = PortId +1;                                   04982000
  double pointer PortCB'dbl = PortCB;                                   04983000
                                                                        04984000
  integer aftioqx;                                                      04985000
  integer pointer msg,                                                  04986000
                  Context;                                              04987000
                                                                        04988000
  integer Result;                                                       04989000
  array Name(0:7);  << massaged ClassName >>                            04990000
  integer array DictData(0:7) = Q;                                      04991000
  integer DictPlabel = DictData +0,                                     04992000
          DictType   = DictData +1,                                     04993000
          DictContext= DictData +2,                                     04994000
          DictMsgSize= DictData +3,                                     04995000
          DictNumSubqueues = DictData +4;                               04996000
                                                                        04997000
  CreateIOWaitPort := 0D;                                               04998000
  GenerateDictName(ClassName,Name);                                     04999000
                                                                        05000000
  DictFind(Name,DictData,Result);                                       05001000
  if Result <> 0 then return;                                           05002000
                                                                        05003000
  Create'IOWaitPort(PortDST, DictPlabel, DictNumSubqueues,              05004000
                    DictContext, PortId, Result);                       05005000
                                                                        05006000
  end;   << CreateIOWaitPort >>                                         05007000
procedure Create'IOWaitPort(PortDST, Plabel, NumSubques, ContextSize,   05008000
                            PortId',  Result);                          05009000
  value                     PortDST, Plabel, NumSubques, ContextSize;   05010000
  integer          Result,  PortDST, Plabel, NumSubques, ContextSize;   05011000
  double                    PortId';                                    05012000
  option privileged,uncallable;                                         05013000
                                                                        05014000
  begin                                                                 05015000
  equate badparm1 = 1,                                                  05016000
         badparm2 = 2,                                                  05017000
         splitstk = 10,                                                 05018000
         nomore   = 11;                                                 05019000
  double PortId;                                                        05020000
  logical pointer PortCB = PortId +1;                                   05021000
  double pointer PortCB'dbl = PortCB;                                   05022000
                                                                        05023000
  integer aftioqx;                                                      05024000
  integer pointer msg,                                                  05025000
                  Context;                                              05026000
                                                                        05027000
  Result := 0;                                                          05028000
                                                                        05029000
                                                                        05030000
  CreatePort'(PortDST, 3, @IOWaitPort'server, NumSubques,               05031000
              ContextSize+IOWait'usercontext, PortId, Result);          05032000
  if Result > 1 then Result := Result - 1;                  <<00002>>   05033000
  if Result <> 0 then go to Exit;                                       05034000
  aftioqx := Allocate'IOWait'index(PortId);                             05035000
  if aftioqx = 0 then                                                   05036000
    begin  << out of entries >>                                         05037000
    DeletePort(PortId);                                                 05038000
    PortId := 0D;                                                       05039000
    Result := nomore;                                                   05040000
    go to Exit;                                                         05041000
    end;                                                                05042000
                                                                        05043000
  exchangedb(PortDST);                                                  05044000
                                                                        05045000
  << Initialize PortCB and context area >>                              05046000
  @Context := PortCB'context;                                           05047000
  PortCB'subtype := IOWait'subtype;                                     05048000
                                                                        05049000
  IOWait'portplabel := Plabel;                                          05050000
  IOWait'aftioqx := aftioqx;                                            05051000
  exchangedb(0);                                                        05052000
  PortId' := PortId;                                                    05053000
                                                                        05054000
Exit:  end;   << CreateIOWaitPort >>                                    05055000
$page "IOWait Ports - ChangeIOWaitPort"                                 05056000
integer procedure ChangeIOWaitPort(PortId,AFTindex,Pin,Plabel);         05057000
  value PortId,AFTindex,Pin,Plabel;                                     05058000
  double PortId;                                                        05059000
  integer AFTindex,Pin,Plabel;                                          05060000
  option privileged,uncallable;                                         05061000
                                                                        05062000
  begin                                                                 05063000
  << NOTE: must be called on stack assoc. with port >>                  05064000
  << NOTE: must be called with DB at stack DB >>                        05065000
  logical to'iowait'mode;                                   <<00001>>   05066000
  integer dl, ioqx;                                         <<00001>>   05067000
  integer pointer aft;                                      <<00001>>   05068000
  integer pointer Context;                                              05069000
  std'decl;                                                             05070000
                                                                        05071000
  if Pin = 0 then Pin := curpin;                                        05072000
                                                                        05073000
  exchangedb'to'PortDST;                                                05074000
  @Context := PortCB'context;                                           05075000
  if (Plabel <> 0) and (IOWait'count > 0)                   <<00001>>   05076000
    then suddendeath(badportcall);                          <<00001>>   05077000
                                                                        05078000
  ChangeIOWaitPort := IOWait'softint'plabel;                            05079000
  to'iowait'mode := (Plabel = 0) land                       <<00001>>   05080000
    (IOWait'softint'plabel <> 0) land                       <<00001>>   05081000
    (IOWait'count > 0);                                     <<00001>>   05082000
  ioqx := IOWait'aftioqx;                                   <<00001>>   05083000
  IOWait'softint'plabel := Plabel;                                      05084000
  IOWait'aftindex := AFTindex;                                          05085000
  PortCB'pin := Pin;                                                    05086000
                                                            <<00042>>   05087000
  if to'iowait'mode then                                    <<00042>>   05088000
    PortCB'enabled := false;                                <<00042>>   05089000
                                                            <<00042>>   05090000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 05091000
                                                                        05092000
  if to'iowait'mode then begin                              <<00001>>   05093000
    disable;                                                <<00001>>   05094000
                                                            <<00042>>   05095000
    enable;                                                 <<00001>>   05096000
    push(dl);  dl := tos;                                   <<00001>>   05097000
    @aft := - AFTindex * aftsize + dl - aft'base;           <<00001>>   05098000
    aft(to'ioqx) := ioqx;                                   <<00001>>   05099000
    end;                                                    <<00001>>   05100000
  end;   << ChangeIOWaitPort >>                                         05101000
$page "IOWait Ports - IncrementIOCount"                                 05102000
integer procedure IncrementIOCount(PortId);                             05103000
  value PortId;                                                         05104000
  double PortId;                                                        05105000
  option privileged,uncallable;                                         05106000
                                                                        05107000
  begin                                                                 05108000
  << NOTE: must be called on stack assoc. with port >>                  05109000
  << NOTE: must be called with DB at stack DB >>                        05110000
  integer NewCount = IncrementIOCount;                                  05111000
  integer pointer Context,                                              05112000
                  aft;                                                  05113000
  integer ioqx,                                                         05114000
          fnum,   << aft index >>                                       05115000
          dl;     << DL Register value >>                               05116000
  std'decl;                                                             05117000
                                                                        05118000
  exchangedb'to'PortDST;                                                05119000
  @Context := PortCB'context;                                           05120000
                                                                        05121000
  if portcb'pin <> curpin then                              <<00046>>   05122000
    suddendeath(badportcall);                               <<00046>>   05123000
                                                            <<00046>>   05124000
  fnum := IOWait'aftindex;                                              05125000
  ioqx := if IOWait'softint'plabel <> 0                                 05126000
            then softintpend                                            05127000
            else IOWait'aftioqx;                                        05128000
  disable;                                                              05129000
  IOWait'count := IOWait'count +1;                                      05130000
  NewCount := IOWait'count;                                             05131000
  enable;                                                               05132000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 05133000
  if NewCount = 1 then                                                  05134000
    begin  << set ioqx into aft for IOWAITs use >>                      05135000
    push(dl);  dl := tos;                                               05136000
    @aft := -fnum*aftsize + dl - aft'base;                              05137000
    aft(to'ioqx) := ioqx;                                               05138000
    if ioqx = softintpend then PortEnable(PortId);                      05139000
    end;                                                                05140000
                                                                        05141000
  end;   << IncrementIOCount >>                                         05142000
$page "IOWait Ports - CheckIOCount"                                     05143000
integer procedure CheckIOCount(PortId);                                 05144000
  value PortId;                                                         05145000
  double PortId;                                                        05146000
  option privileged,uncallable;                                         05147000
                                                                        05148000
  begin                                                                 05149000
  integer pointer Context;                                              05150000
  std'decl;                                                             05151000
                                                                        05152000
  exchangedb'to'PortDST;                                                05153000
  @Context := PortCB'context;                                           05154000
  CheckIOCount := IOWait'count;                                         05155000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 05156000
                                                                        05157000
  end;   << CheckIOCount >>                                             05158000
$page "IOWait Ports - Allocate'IOWait'index"                            05159000
                                                                        05160000
integer procedure Allocate'IOWait'index(PortId);                        05161000
  value PortId;                                                         05162000
  double PortId;                                                        05163000
  option privileged,uncallable,internal;                                05164000
  begin                                                                 05165000
  double pointer IOWait'index = Allocate'IOWait'index;                  05166000
                                                                        05167000
  << IOWait Port Vector Table structure >>                              05168000
  Integer CurrentDSTSize = DB +0,                                       05169000
          MaxDSTSize = DB +1;                                           05170000
  integer pointer Index'PoolHead = DB +2,                               05171000
                  Index'PoolTail = DB +3;                               05172000
  integer LockWord = DB +4;  << obtain/release need four words >>       05173000
  equate IOWait'headersize = 8;                                         05174000
  equate nil = -1;                                                      05175000
  equate entrysize = 2;                                     <<00018>>   05176000
                                                                        05177000
  << local variables >>                                                 05178000
                                                                        05179000
  integer pointer Index'element;                                        05180000
  integer oldsize,newsize;                                              05181000
                                                                        05182000
  if exchangedb(IOWait'PortId'DST) <> 0 then suddendeath(wrongDST);     05183000
  obtain(LockWord,nil);                                                 05184000
                                                                        05185000
  if @Index'PoolHead = 0 then                                           05186000
    begin  << try to expand DST >>                                      05187000
    oldsize := CurrentDSTSize;                                          05188000
    newsize := altdsegsize(IOWait'PortId'DST, 256);                     05189000
    if <> then                                                          05190000
      begin  << expansion failed, bail out >>                           05191000
      @IOwait'index := 0;                                               05192000
      release(LockWord,nil,true);                                       05193000
      exchangedb(0);                                                    05194000
      return;  << return to caller >>                                   05195000
      end;                                                              05196000
    @Index'element := oldsize;                                          05197000
    @Index'PoolHead := @Index'element;                                  05198000
    while @Index'element < newsize - 2*entrysize do         <<00018>>   05199000
      begin                                                             05200000
      @Index'element := Index'element :=                    <<00018>>   05201000
                       @Index'element + entrysize;          <<00018>>   05202000
      end;                                                              05203000
    @Index'PoolTail := @Index'element;                                  05204000
    Index'element := 0;                                     <<00018>>   05205000
    CurrentDSTSize := @Index'element + entrysize;           <<00018>>   05206000
    end;  << DST expansion >>                                           05207000
                                                                        05208000
  @IOWait'index := @Index'PoolHead;                                     05209000
  @Index'PoolHead := Index'PoolHead;                                    05210000
  if = then                                                             05211000
    @Index'PoolTail := 0;  << Pool Now empty >>                         05212000
                                                                        05213000
  IOWait'index := PortId;                                               05214000
                                                                        05215000
  Release(LockWord,nil,true);                                           05216000
  exchangedb(0);                                                        05217000
                                                                        05218000
  end;   << Allocate'IOWait'index >>                                    05219000
$page "IOWait Ports - Release'IOWait'index"                             05220000
                                                                        05221000
procedure Release'IOWait'index(Index);                                  05222000
  value Index;                                                          05223000
  integer Index;                                                        05224000
  option privileged,uncallable,internal;                                05225000
  begin                                                                 05226000
  integer pointer IOWait'index;                                         05227000
                                                                        05228000
  << IOWait Port Vector Table structure >>                              05229000
  Integer CurrentSize = DB +0,                                          05230000
          MaxDSTSize = DB +1;                                           05231000
  Integer Pointer Index'PoolHead = DB +2,                               05232000
                  Index'PoolTail = DB +3;                               05233000
  integer LockWord = DB +4;  << obtain/release need four words >>       05234000
  equate IOWait'headersize = 8;                                         05235000
  equate nil = -1;                                                      05236000
                                                                        05237000
  if exchangedb(IOWait'PortId'DST) <> 0 then suddendeath(wrongDST);     05238000
  obtain(LockWord,nil);                                                 05239000
                                                                        05240000
  @IOWait'index := Index;                                               05241000
  IOWait'index := 0;                                                    05242000
  if @Index'PoolHead <> 0 then                                          05243000
    begin  << Pool not empty, queue to tail >>                          05244000
    @Index'PoolTail := Index'PoolTail := @IOWait'index;                 05245000
    end                                                                 05246000
  else                                                                  05247000
    begin  << pool was empty, should never happen >>                    05248000
    @Index'PoolHead := @Index'PoolTail := @IOWait'index;                05249000
    end;                                                                05250000
                                                                        05251000
  Release(LockWord,nil,true);                                           05252000
  exchangedb(0);                                                        05253000
                                                                        05254000
  end;   << Release'IOWait'index >>                                     05255000
$page "IOWait Ports - sort fnums"                                       05256000
PROCEDURE sort(a,n);                                                    05257000
   VALUE n; INTEGER n;                                                  05258000
   DOUBLE ARRAY a;                                                      05259000
   OPTION INTERNAL;                                                     05260000
BEGIN <<Elements 1 to n of the array 'a' are sorted in place, using     05261000
        Floyd's treesort algorithm.  Each element is a double word.>>   05262000
   INTEGER f,s,          <<used to index up & down the tree>>           05263000
      root,              <<index of root of subtree>>                   05264000
      limit;             <<index of last node not yet sorted>>          05265000
   DOUBLE POINTER a1;    <<points to 1st element>>                      05266000
   LOGICAL done;         <<found correct tree location>>                05267000
   DOUBLE t;         <<used to hold one element>>                       05268000
                                                                        05269000
   limit:=n; @a1:=@a+2;     <<initialize locals>>                       05270000
                                                                        05271000
<<create the heap, i.e., insure that a(i)>a(2i) for all i>>             05272000
                                                                        05273000
   FOR root:=n&lsr(1) STEP -1 UNTIL 1 DO                                05274000
   BEGIN <<move a(root) down to correct place in subheap>>              05275000
      done :=  FALSE;                                                   05276000
      t:=a(root);                                                       05277000
      s:=root;                                                          05278000
      WHILE NOT done AND (s:=(f:=s)&lsl(1)) <= limit DO                 05279000
      BEGIN <<find bigger son>>                                         05280000
         IF < AND a(s)<a1(s) THEN s:=s+1; <<ccl from limit test>>       05281000
         IF t<a(s) THEN                                                 05282000
            BEGIN <<swap with bigger son>>                              05283000
               a(f):=a(s);                                              05284000
            END                                                         05285000
         ELSE done := TRUE;                                             05286000
      END;                                                              05287000
      a(f):=t;                                                          05288000
   END;  <<create heap>>                                                05289000
                                                                        05290000
<<Select phase.  At each step, 1st element is largest, so switch it     05291000
  and last, then move last to correct place in new heap.>>              05292000
                                                                        05293000
   WHILE limit>1 DO                                                     05294000
   BEGIN                                                                05295000
      t:=a(limit);     <<save last element>>                            05296000
      a(limit):=a1;                                                     05297000
      limit:=limit-1; s:=1;                                             05298000
                                                                        05299000
<<Move element down to bottom of tree, assuming it is less than anything05300000
  else.  This is usually true, so we should save some compares.>>       05301000
                                                                        05302000
      WHILE (s:=(f:=s)&lsl(1)) <= limit DO                              05303000
      BEGIN                                                             05304000
         IF < AND a(s)<a1(s) THEN s:=s+1; <<ccl from limit test>>       05305000
         a(f):=a(s);                                                    05306000
      END;                                                              05307000
                                                                        05308000
<<Now check from bottom up to see if we were wrong>>                    05309000
      WHILE (f:=(s:=f)&lsr(1)) > 0 AND a(f)<t DO                        05310000
         a(s):=a(f);                                                    05311000
      a(s):=t;                                                          05312000
   END <<selection>>;                                                   05313000
END <<sort>>;                                                           05314000
  PROCEDURE AFT'CLEANUP'INIT;                               <<00029>>   05315000
<<                                                                      05316000
   ADDS PLABELS OF SUBSYSTEMS'S AFT CLEANUP                             05317000
   PROCEDURES TO THE PORT DICTIONARY.  THESE WILL BE                    05318000
   RETRIEVED AND PCAL'ED BY IOWAITPORT'EXPIRE WHEN                      05319000
   A PROCESS WHICH HAS PORT AFT'S TERMINATES.              >>           05320000
    BEGIN                                                   <<00029>>   05321000
    INTEGER ARRAY NAME(0:7) = Q, PLABEL(0:6) = Q;           <<00029>>   05322000
    BYTE ARRAY PROCNAME(*) = NAME + 1;                      <<00029>>   05323000
    INTEGER LEN, RESULT, SUBSYS := 15;                      <<00029>>   05324000
                                                            <<00029>>   05325000
    INTRINSIC LOADPROC, ASCII;                              <<00029>>   05326000
                                                            <<00029>>   05327000
    NAME := %5400;                                          <<00029>>   05328000
    MOVE PROCNAME := "DCL'AFT'  ";                          <<00029>>   05329000
    WHILE SUBSYS >= 0 DO                                    <<00029>>   05330000
      BEGIN                                                 <<00029>>   05331000
      LEN := ASCII(SUBSYS, 10, PROCNAME(8));                <<00029>>   05332000
      PROCNAME(LEN+8) := " ";                               <<00029>>   05333000
      RESULT := LOADPROC(PROCNAME, 0, PLABEL);              <<00029>>   05334000
      IF = THEN DICTADD(NAME, PLABEL, RESULT);              <<00029>>   05335000
      SUBSYS := SUBSYS - 1;                                 <<00029>>   05336000
      END;                                                  <<00029>>   05337000
    END;                                                    <<00029>>   05338000
$page "IOWait Ports - IOWaitPort'expire"                                05339000
procedure IOWaitPort'expire;                                            05340000
  option privileged,uncallable;                                         05341000
  begin                                                                 05342000
comment  This procedure is called by the filesystem procedure           05343000
    "fprocterm" when a process terminates.  The intent is to            05344000
    release all resources associated with the current process.          05345000
    The assumption is that all of these resources may be located        05346000
    thru the AFT table.                                                 05347000
    IOWait ports are released in order, based upon the subtype.         05348000
    This allows, for example, remote files to be closed before          05349000
    the underlying remote connection is closed.                         05350000
  ;                                                                     05351000
  integer pointer pxfile;                                               05352000
  integer pointer aft;                                                  05353000
  integer pointer dl;                                                   05354000
                                                                        05355000
integer Result;                                             <<00029>>   05356000
integer array Subtype'Data(0:6), Name(0:8) = q;             <<00029>>   05357000
  integer fnum := 0,                                                    05358000
          num'entries := 0,                                             05359000
          last'subtype := -1,                                           05360000
          subtype'plabel := 0,                                          05361000
          identnum,                                                     05362000
          len,                                                          05363000
          num'afts,                                                     05364000
          sort'index;                                                   05365000
  double sort'info;                                                     05366000
  integer sort'subtype = sort'info,                                     05367000
          sort'fnum = sort'info +1;                                     05368000
  double pointer sort'table;  << alloc. array on TOS >>                 05369000
                                                                        05370000
byte array procname(*) = Name + 1;                          <<00029>>   05371000
byte array warnmsg(0:46);                                               05372000
  integer S0 = S-0;                                                     05373000
  intrinsic ascii,loadproc,unloadproc,debug;                            05374000
  intrinsic print;                                          <<00003>>   05375000
                                                                        05376000
  << Find all IOWaitPort AFTs, and produce a double word >>             05377000
  << for each such entry. This double word is constructed >>            05378000
  << from the aft subtype and the opposite of the aftindex. >>          05379000
  << The array of all such double words is then sorted in >>            05380000
  << assending order, producing a double array with all >>              05381000
  << AFTs of subtype zero first, followed by subtype one, etc. >>       05382000
  << Within a subtype, the largest aft index is first, due to >>        05383000
  << negating the aft index when constructing the sort entry. >>        05384000
  << A variable sized array to hold the list of IOWaitPort AFTs >>      05385000
  << is allocated on the top of stack since the maximum size >>         05386000
  << is not known. >>                                                   05387000
                                                                        05388000
  push(dl);                                                             05389000
  @dl := tos;                                                           05390000
  @pxfile := @dl - dl(-3);                                              05391000
  num'afts := pxfile(to'pxaftsize)/aftsize;                             05392000
  @sort'table := @S0 +1;                                                05393000
  asmb( dzro );  << space for sort'table(0) >>                          05394000
  << Must use while loop, since add to TOS >>                           05395000
  while (fnum := fnum +1) <= num'afts do                                05396000
    begin                                                               05397000
    @aft := @dl - fnum*aftsize - aft'base;                              05398000
    if aft'type = iowaitport'type then                                  05399000
      begin                                                             05400000
      sort'subtype := aft'subtype;                                      05401000
      sort'fnum := -fnum;  << release largest fnum first >>             05402000
      num'entries := num'entries +1;                                    05403000
      << sort'table(num'entries) := sort'info; >>                       05404000
      tos := sort'info;                                                 05405000
      end;                                                              05406000
    end;                                                                05407000
                                                                        05408000
  move procname := "DCL'AFT' ";                                         05409000
Name := %5400;                                              <<00029>>   05410000
  move warnmsg :=                                           <<00003>>   05411000
   "CLOSE PROCEDURE MISSING FOR SUBTYPE   (IPC 001)";       <<00003>>   05412000
                                                                        05413000
  if num'entries > 1 then sort(sort'table,num'entries);                 05414000
  sort'index := 0;                                          <<00003>>   05415000
  while (sort'index:= sort'index+1) <= num'entries do       <<00003>>   05416000
    begin                                                               05417000
    sort'info := sort'table(sort'index);                                05418000
    num'afts := pxfile(to'pxaftsize)/aftsize;                           05419000
    fnum := -sort'fnum;                                                 05420000
    @aft := @dl - fnum*aftsize - aft'base;                              05421000
    if fnum <= num'afts and aft(0) <> 0 then                            05422000
      begin  << aft still exists, try to close it >>                    05423000
      if sort'subtype <> last'subtype then                              05424000
        begin  << load the plabel for the new subtype >>                05425000
        len := ascii(sort'subtype,10,procname(8));                      05426000
        procname(len + 8) := " ";                                       05427000
DictFind(Name, Subtype'Data, Result);                       <<00029>>   05428000
if Result = 0 then                                          <<00029>>   05429000
  subtype'plabel := Subtype'Data                            <<00029>>   05430000
else                                                        <<00029>>   05431000
          begin                                                         05432000
          subtype'plabel := 0;                              <<00003>>   05433000
          aft := 0;                                         <<00003>>   05434000
          move aft(1) := aft,(aftsize - 1);                 <<00003>>   05435000
          ascii(sort'subtype, 10, warnmsg(36));             <<00003>>   05436000
  print(warnmsg, -47, %40);                                 <<00003>>   05437000
          go to next;                                       <<00003>>   05438000
          end;                                                          05439000
        last'subtype := sort'subtype;                                   05440000
        end;                                                            05441000
      << call "DCL'AFT'nn(fnum);" to cleanup aft >>                     05442000
      tos := fnum;                                                      05443000
      tos := subtype'plabel;                                            05444000
      asmb( pcal 0 );                                                   05445000
      end;                                                              05446000
next: end;                                                  <<00003>>   05447000
                                                                        05448000
                                                                        05449000
  LooseSoftInterrupts;                                      <<00003>>   05450000
  end;  << IOWaitPort'expire >>                                         05451000
$PAGE "MESSAGE FACILITY INTRINSICS : SEND MESSAGE"                      05452000
PROCEDURE SENDMSG(DESTPIN, SUBQUEUE, MSGLENGTH, FLAGS);     <<00015>>   05453000
  VALUE           DESTPIN, SUBQUEUE, MSGLENGTH, FLAGS;                  05454000
  INTEGER         DESTPIN, SUBQUEUE, MSGLENGTH;                         05455000
  LOGICAL                                       FLAGS;                  05456000
  OPTION PRIVILEGED,UNCALLABLE;                                         05457000
                                                                        05458000
COMMENT                                                                 05459000
                                                                        05460000
SENDMSG IS CALLED TO DELIVER A SHORT MESSAGE OF MSGLENGTH WORDS         05461000
TO THE SPECIFIED SUBQUEUE OF THE PROCESS SPECIFIED BY DESTPIN.          05462000
                                                                        05463000
THE FLAGS PARAMETER CONTROLS THE PROCEDURE AS FOLLOWS :                 05464000
                                                                        05465000
    FLAGS.MSGWAKEUPFLAG=1 ==> WAKE-UP DESTINATION PROCESS        HM.XX  05466000
    FLAGS.MSGDONT'PREEMPTFLAG=1 ==> DON'T BOTHER PREEMPTING THE CURRENT 05467000
                                    PROCESS TO GET THIS MESSAGE         05468000
                                                                        05469000
SENDMSG EXPECTS THE FIRST WORD OF THE MESSAGE TO BE AT Q-7-MSGLENGTH    05470000
AND THE LAST WORD TO BE AT Q-8.  ON EXIT THE STACKED MESSAGE CONTENTS   05471000
ARE DELETED.                                                            05472000
                                                                        05473000
IF THE FLAGS SPECIFY THAT THE DESTINATION PROCESS BE AWAKENED, THE      05474000
RETURN CC IS SET TO CCG IF THE PROCESS IS ALREADY AWAKE.                05475000
                                                                        05476000
THE MESSAGE CONTENTS STACKED BY THE CALLER ARE DELETED ON THE EXIT      05477000
FROM SENDMSG.                                                           05478000
                                                                        05479000
;                                                                       05480000
                                                                        05481000
BEGIN                                                                   05482000
                                                                        05483000
DEFINE MSGDON'TPREEMPTFLAG = (2:1)#;                                    05484000
DEFINE MSGWAKEUPFLAG = (1:1)#;                                          05485000
                                                                        05486000
EQUATE PARMCNT=4, <<INCOMING PARAMETER COUNT>>                          05487000
       LASTMSGWORD=3+PARMCNT;                                           05488000
                                                                        05489000
ARRAY MSGARRAY(*)=Q - LASTMSGWORD ;<<STARTS AT Q-7>>                    05490000
                                                                        05491000
COMMENT                                                                 05492000
                                                                        05493000
ALL CALLS TO THIS PROCEDURE SHOULD BE REPLACED WITH                     05494000
CALLS TO THE PORT PROCEDURE PRIMITIVES DIRECTLY.                        05495000
                                                                        05496000
;                                                                       05497000
EQUATE MAXSUBQUEUE = 4,   << SUBQUEUES 0-4 VALID >>                     05498000
       MAXMSGLENGTH = 4;                                                05499000
                                                                        05500000
DOUBLE PORTID;                                                          05501000
                                                                        05502000
INTEGER PIN;                                                            05503000
                                                                        05504000
INTEGER POINTER DESTMSG, MSG;                                           05505000
                                                                        05506000
  std'decl2;                                                            05507000
  std'decl;                                                             05508000
                                                                        05509000
  IF NOT ( 0 <= SUBQUEUE <= MAXSUBQUEUE) THEN                           05510000
    SUDDENDEATH(BADPORTCALL);                                           05511000
                                                                        05512000
  IF NOT (0 <= DESTPIN <= MAX'PIN) THEN                                 05513000
    SUDDENDEATH(BADPORTCALL);                                           05514000
                                                                        05515000
  IF NOT (0 <= MSGLENGTH <= MAXMSGLENGTH) THEN                          05516000
    SUDDENDEATH(BADPORTCALL);                                           05517000
                                                                        05518000
  PORTDST := MsgHarbTabDSTN;                                            05519000
  @PORTCB  := DESTPIN * MsgHarbPortLength + MsgHarbHeaderSize;          05520000
                                                                        05521000
  db'to'PortDST;                                                        05522000
                                                                        05523000
 << allocate'message'frame >>                                           05524000
  PoolCnt := PoolCnt - 1;                                               05525000
  if < then                                                             05526000
     begin << $1 >>                                                     05527000
     on'ics;  << set tos if on ics, or pdisable > 1 >>                  05528000
     if (not tos) and logical(OldStatus.(1:1)) then                     05529000
       do begin << $2 >>                                                05530000
         PoolCnt := PoolCnt + 1;                                        05531000
         WaitForMsg; << does an exchangeDB'to'PortDST >>                05532000
         PoolCnt := PoolCnt - 1;                                        05533000
       end until >=;  << $2 >>                                          05534000
     end;  << $1 >>                                                     05535000
                                                                        05536000
  @msg := @MsgPoolHead;                                                 05537000
  if = then suddendeath(badport);                                       05538000
  @MsgPoolHead :=  MsgPoolHead; << delink msg >>                        05539000
  if = then @MsgPoolTail := 0;  << pool now empty >>                    05540000
                                                                        05541000
  msg := 0; << break msg link into free pool >>                         05542000
  msg(msg'length) := MSGLENGTH + 2;                                     05543000
                                                                        05544000
 << move data to message frame a word at a time >>                      05545000
  x := -MSGLENGTH ;                                                     05546000
  @destmsg := @msg - x + 2;                                             05547000
  do begin                                                              05548000
    destmsg(x) := MSGARRAY(x);                                          05549000
    end until IXBZ;                                                     05550000
                                                                        05551000
 << link to subqueue >>                                                 05552000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   05553000
  if @qhead <> 0 then                                                   05554000
    begin << not the first message >>                                   05555000
    @qtail := qtail := @msg; << queue to tail >>                        05556000
    PortCB'dbl(x) := dbl'ptrs;                                          05557000
    end                                                                 05558000
  else                                                                  05559000
    begin << first message in the queue >>                              05560000
    tos := tos := @msg; << queue to the front >>                        05561000
    PortCB'dbl(x) := tos;                                               05562000
    set'message'bit; << set flags to indicate a msg is present >>       05563000
    end;                                                                05564000
                                                                        05565000
  exchangeDB'back;                                                      05566000
                                                                        05567000
<<WAKE-UP DESTINATION PROCESS IF CALLER SO REQUESTED>>                  05568000
                                                                        05569000
IF FLAGS.MSGWAKEUPFLAG                                                  05570000
THEN AWAKE(DESTPIN*PCBSIZE,MSGWAITCODE,NOWAIT);                         05571000
IF DESTPIN=0 THEN                                                       05572000
   BEGIN <<SPECIAL FOR SCHEDULER MESSAGES>>                             05573000
   IF ABSOLUTE(SYSDISPAWAKEMSG).DISPRUNNINGFLAG                         05574000
   AND NOT ABSOLUTE(SYSDISPAWAKEMSG).PAUSEDFLAG                         05575000
   THEN ABSOLUTE(SYSAWAKESCHEDMSG):=0<<PREEMPT CUR ACT>>                05576000
    ELSE IF (NOT FLAGS.MSGDON'TPREEMPTFLAG)                             05577000
    OR (ABSOLUTE(SYSDISPAWAKEMSG).PAUSEDFLAG) THEN ASMB(DISP);          05578000
   END;                                                                 05579000
                                                                        05580000
<<BUILD AND EXECUTE AN EXIT INSTRUCTION TO DELETE STACKED MSG>>         05581000
                                                                        05582000
TOS:=MSGLENGTH+PARMCNT; <<# OF PARAMETERS TO DELETE>>                   05583000
TOS:=TOS LOR (%31400); <<BUILD EXIT INSTRUCTION>>                       05584000
ASMB(XEQ 0);                                                            05585000
END <<PROCEDURE SENDMSG>>;                                              05586000
$PAGE "MESSAGE FACILITY INTRINSICS : PORT STATUS"                       05587000
INTEGER PROCEDURE PORTSTATUS(SUBQUEUE);                     <<00015>>   05588000
  VALUE                      SUBQUEUE;                                  05589000
  INTEGER                    SUBQUEUE;                                  05590000
  OPTION PRIVILEGED,UNCALLABLE;                                         05591000
                                                                        05592000
COMMENT                                                                 05593000
                                                                        05594000
WHEN SUPPLIED A VALID SUBQUEUE, PORTSTATUS RETURNS A TRUE               05595000
VALUE IF THE SUBQUEUE IS NON-EMPTY AND A FALSE VALUE IF THE SUBQUEUE    05596000
IS EMPTY.                                                               05597000
                                                                        05598000
WHEN PASSED A -1 AS PORTNUMBER PARAMETER, PORTSTATUS RETURNS            05599000
THE PORTNUMBER OF THE PROCESS' MOST URGENT NON-EMPTY SUBQUEUE (WHERE    05600000
THE CONVENTION OF LOWER NUMERICAL SUBQUEUE NUMBERS RELATING TO MORE     05601000
URGENT SUBQUEUE IS UNDERSTOOD).                                         05602000
                                                                        05603000
IF ALL SUBQUEUES ARE EMPTY, PORTSTATUS RETURNS CC=CCE.  IF AT LEAST     05604000
ONE SUBQUEUE IS NON-EMPTY, PORTSTATUS RETURNS CC=CCG.                   05605000
                                                                        05606000
;                                                                       05607000
                                                                        05608000
                                                                        05609000
BEGIN                                                                   05610000
                                                                        05611000
COMMENT                                                                 05612000
                                                                        05613000
ALL CALLS TO THIS PROCEDURE SHOULD BE REPLACED WITH                     05614000
CALLS TO THE PORT PROCEDURE PRIMITIVES DIRECTLY.                        05615000
                                                                        05616000
;                                                                       05617000
EQUATE MAXSUBQUEUE = 4,   << SUBQUEUES 0-4 VALID >>                     05618000
       MAXMSGLENGTH = 4;                                                05619000
                                                                        05620000
DOUBLE PORTID;                                                          05621000
                                                                        05622000
                                                                        05623000
  std'decl2;                                                            05624000
  std'decl;                                                             05625000
                                                                        05626000
  PORTDST := MsgHarbTabDSTN;                                            05627000
  @PORTCB  := if abs(CPCB) = 0 then                                     05628000
               MsgHarbHeaderSize                                        05629000
             else                                                       05630000
               curpin * MsgHarbPortLength + MsgHarbHeaderSize;          05631000
                                                                        05632000
  PORTSTATUS := FALSE; << ASSUME NO MESSAGES PENDING >>                 05633000
  CC := CCE;                                                            05634000
                                                                        05635000
  db'to'PortDST;                                                        05636000
                                                                        05637000
  tos := PortCB'flags;                                                  05638000
                                                                        05639000
ASSEMBLE( TEST );                                                       05640000
IF <> THEN                                                              05641000
  BEGIN << AT LEAST ONE SUBQUEUE NON-EMPTY >>                           05642000
  CC := CCG;                                                            05643000
  IF SUBQUEUE <> -1 THEN                                                05644000
    BEGIN << CHECK SPECIFIC SUBQUEUE >>                                 05645000
    IF NOT (0 <= SUBQUEUE <= MAXSUBQUEUE) THEN                          05646000
      SUDDENDEATH(BADPORTCALL);                                         05647000
   << XREG SET BY COMPARE RANGE ABOVE >>                                05648000
    ASSEMBLE( TBC 0,X );                                                05649000
    IF <> THEN PORTSTATUS := TRUE;                                      05650000
    END                                                                 05651000
  ELSE                                                                  05652000
    BEGIN << RETURN HIGHEST PRIORITY NON-EMPTY SUBQUEUE >>              05653000
    ASSEMBLE( SCAN );                                                   05654000
    PORTSTATUS := X;                                                    05655000
    IF X > MAXSUBQUEUE THEN SUDDENDEATH(BADPORT);                       05656000
    END;                                                                05657000
  END;                                                                  05658000
                                                                        05659000
  del;                                                                  05660000
                                                                        05661000
exchangeDB'back;                                                        05662000
                                                                        05663000
END <<PROCEDURE PORTSTATUS>>;                                           05664000
$PAGE "MESSAGE FACILITY INTRINSICS : RECEIVE MESSAGE"                   05665000
PROCEDURE RECEIVEMSG(SUBQUEUE, MSGLENGTH, FLAGS);           <<00015>>   05666000
  VALUE              SUBQUEUE, MSGLENGTH, FLAGS;                        05667000
  INTEGER            SUBQUEUE, MSGLENGTH;                               05668000
  LOGICAL                                 FLAGS;                        05669000
  OPTION PRIVILEGED,UNCALLABLE;                                         05670000
                                                                        05671000
COMMENT                                                                 05672000
                                                                        05673000
RECEIVEMSG IS CALLED TO OBTAIN THE CONTENTS OF THE MESSAGE              05674000
AT THE HEAD OF THE CALLING PROCESS' MSG PORT (SPECIFIED                 05675000
BY SUBQUEUE PARAMETER).                                                 05676000
                                                                        05677000
THE CALLER OF RECEIVEMSG DOES AN ASMB(ADDS MSGLENGTH) TO MAKE           05678000
SPACE FOR THE MSG CONTENTS.  RECEIVEMSG DEPOSITS THE MSG CONTENTS       05679000
INTO Q-6-msg'length,...,Q-7, WITH THE FIRST WORD OF THE SENT            05680000
MESSAGE DEPOSITED INTO Q-6-msg'length.                                  05681000
THE PARAMETER MSGLENGTH IS USED ONLY TO CHECK THE LENGTH OF THE         05682000
MESSAGE RECEIVED.  IT IS NOT USED TO DETERMINE HOW MANY WORDS ARE       05683000
MOVED TO THE STACK.                                                     05684000
                                                                        05685000
THE CALLER HAS THE OPTION OF A NON-DESTRUCTIVE READ OF THE MESSAGE.     05686000
FLAGS.MSGNONDESTRUCT=1 ==> RETURN CONTENTS OF MESSAGE, BUT LEAVE        05687000
                           MESSAGE AT THE HEAD OF THE SUBQUEUE.         05688000
FLAGS.MSGWAITONEMPTY=1 ==> WAIT THE CALLER ON A MESSAGE WAIT            05689000
                           IF THE QUEUE IS EMPTY. (PROCESS              05690000
                           WILL BE REAWAKENED WHEN SOMEBODY             05691000
                           SENDS A MESSAGE TO THE SPECIFIED             05692000
                           SUBQUEUE).                                   05693000
                                                                        05694000
STATUS IS RETURNED THRU THE CC AS FOLLOWS :                             05695000
                                                                        05696000
   IF ALL SUBQUEUES ARE EMPTY AND WAIT NOT SPECIFIED CC:=CCG.           05697000
   IF A MSG BEING RETURNED, CC:=CCE.                                    05698000
                                                                        05699000
                                                                        05700000
;                                                                       05701000
                                                                        05702000
BEGIN                                                                   05703000
                                                                        05704000
DEFINE MSGNONDESTRUCT = (0:1)#,                                         05705000
       MSGWAITONEMPTY = (1:1)#;                                         05706000
                                                                        05707000
EQUATE PARMCNT=3,                                                       05708000
       LASTMSGWORD=3+PARMCNT;                                           05709000
                                                                        05710000
ARRAY MSGARRAY(*)=Q - LASTMSGWORD ; <<STARTS AT Q-6>>                   05711000
                                                                        05712000
COMMENT                                                                 05713000
                                                                        05714000
ALL CALLS TO THIS PROCEDURE SHOULD BE REPLACED WITH                     05715000
CALLS TO THE PORT PROCEDURE PRIMITIVES DIRECTLY.                        05716000
                                                                        05717000
;                                                                       05718000
EQUATE MAXSUBQUEUE = 4,   << SUBQUEUES 0-4 VALID >>                     05719000
       MAXMSGLENGTH = 4;                                                05720000
                                                                        05721000
DOUBLE PORTID;                                                          05722000
                                                                        05723000
INTEGER NEXTPIN,                                                        05724000
        PCB'INDEX;                                                      05725000
                                                                        05726000
INTEGER POINTER SOURCEMSG, MSG;                                         05727000
                                                                        05728000
LOGICAL SUBQUEUEMASK;                                                   05729000
                                                                        05730000
  std'decl2;                                                            05731000
  std'decl;                                                             05732000
                                                                        05733000
  PORTDST := MsgHarbTabDSTN;                                            05734000
  @PORTCB  := IF ABS(CPCB) = 0 THEN                                     05735000
               MsgHarbHeaderSize                                        05736000
             ELSE                                                       05737000
               curpin * MsgHarbPortLength + MsgHarbHeaderSize;          05738000
                                                                        05739000
<< SET THE SUBQUEUE MASK CORRESPONDING TO PORTNUM >>                    05740000
                                                                        05741000
TOS := 0;                                                               05742000
X := SUBQUEUE;                                                          05743000
ASSEMBLE( TSBC 0,X );                                                   05744000
SUBQUEUEMASK := TOS;                                                    05745000
                                                                        05746000
IF NOT ( 0 <= X <= MAXSUBQUEUE) THEN                                    05747000
  SUDDENDEATH(BADPORTCALL);                                             05748000
                                                                        05749000
CC := CCE; << ASSUME EVERY THING WORKED >>                              05750000
                                                                        05751000
TRY'AGAIN:                                                              05752000
db'to'PortDST;                                                          05753000
                                                                        05754000
 << get pointer to first message on given subqueue >>                   05755000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   05756000
  @msg := @qhead;                                                       05757000
                                                                        05758000
  if @msg = 0 then                                                      05759000
    begin << no message present      >>                                 05760000
    IF FLAGS.MSGWAITONEMPTY THEN                                        05761000
      BEGIN                                                             05762000
      EXCHANGEDB'BACK;                                                  05763000
      WAIT(-MSGWAITCODE, NOINFO);                            <<00022>>  05764000
      GO TO TRY'AGAIN;                                                  05765000
      END                                                               05766000
    ELSE CC := CCG << NOWAIT OPTION >>                                  05767000
    end                                                                 05768000
  else                                                                  05769000
    begin  << $1 return the message to the caller >>                    05770000
    x := msg(msg'length) - 2;                                           05771000
    if not (0<= x <=MSGLENGTH) then suddendeath(badportcall);<<00033>>  05772000
    x := -x ;                                                           05773000
    @sourcemsg := @msg - x + 2;                                         05774000
    do begin                                                            05775000
      MSGARRAY(x) := sourcemsg(x);                                      05776000
      end until IXBZ;                                                   05777000
                                                                        05778000
    if not FLAGS.MSGNONDESTRUCT then                                    05779000
      begin << $2 >>                                                    05780000
      dequeue'message;                                                  05781000
                                                                        05782000
    << return the msg back to the free pool >>                          05783000
      msg := 0;                                                         05784000
      if @MsgPoolHead <> 0 then                                         05785000
        begin<< Pool not empty, queue to tail >>                        05786000
        @MsgPoolTail := MsgPoolTail := @msg;                            05787000
        end                                                             05788000
      else                                                              05789000
        begin<< Pool was empty >>                                       05790000
        @MsgPoolHead := @MsgPoolTail := @msg;                           05791000
        end;                                                            05792000
      PoolCnt := PoolCnt + 1;                                           05793000
      if > and ProcHead <> 0 then AwakeForMsg;                          05794000
      end; << $2 >>                                                     05795000
    end; << $1 >>                                                       05796000
                                                                        05797000
  exchangeDB'back;                                                      05798000
                                                                        05799000
                                                                        05800000
END <<PROCEDURE RECEIVEMSG>>;                                           05801000
$page "PortDictionary routines"                                         05802000
procedure DictAdd(Name,Data,Result);                                    05803000
  integer array Name,Data;                                              05804000
  integer Result;                                                       05805000
  option privileged,uncallable;                                         05806000
  begin                                                                 05807000
  entry DictUpdate,DictFind,DictDelete,DictSend;                        05808000
                                                                        05809000
                                                                        05810000
  equate ok = 0,  << Result codes >>                                    05811000
         already'exists =1,                                             05812000
         not'found = 2,                                                 05813000
         table'full = 3;                                                05814000
                                                                        05815000
  integer pointer DictEntry,                                            05816000
                  HashBucket,                                           05817000
                  PrevBucket;                                           05818000
                                                                        05819000
  byte pointer bptr0,bptr1;                                             05820000
                                                                        05821000
  byte array BName(*) = Name;                                           05822000
  logical OldState;                                                     05823000
  integer function,                                                     05824000
          Old'DST,                                                      05825000
          length,                                                       05826000
          HashValue;                                                    05827000
  integer DL'Name,DL'Data;  << DL Reg. relative addresses >>            05828000
  integer pointer Q'Data;  << Q reg. relative addressing >>             05829000
  integer array QM0array(*) = Q-0;  << for Q rel. addressing of Data >> 05830000
  double PortId;                                                        05831000
  integer portId0 = portId,                                             05832000
          PortId1 = PortId +1;                                          05833000
                                                                        05834000
  equate nil = -1;   << used by obtain and release >>                   05835000
  integer pointer Dict'element;                                         05836000
  integer oldsize,newsize;                                              05837000
                                                                        05838000
  equate Port'Dict'DSTN = 17;                                           05839000
                                                                        05840000
  << dictionary DST structure >>                                        05841000
  integer CurrentDSTSize = DB +0,                                       05842000
          MaxDSTSize = DB +1;                                           05843000
  integer pointer Dict'PoolHead = DB +2,                                05844000
                  Dict'PoolTail = DB +3;                                05845000
                                                                        05846000
  << ====== port dictionary lock definitions ====== >>      <<00036>>   05847000
                                                                        05848000
  define                                                                05849000
    queue'process =                                                     05850000
      pcb(curr'pcb'iqptr) := 0;                                         05851000
      if (Lock'Head'Q = 0) and (Lock'Tail'Q = 0) then                   05852000
        begin                                                           05853000
         << assign the first queued process to head and tail >>         05854000
          Lock'Head'Q := curr'process;                                  05855000
          Lock'Tail'Q := Lock'Head'Q;                                   05856000
          Lock'Q'Len := 1;                                              05857000
        end                                                             05858000
      else                                                              05859000
        begin                                                           05860000
         << queue up the process to the tail of the lock Q   >>         05861000
          pcb(tail'pcb'iqptr) := curr'process;                          05862000
          Lock'Tail'Q := curr'process;                                  05863000
          Lock'Q'Len := Lock'Q'Len + 1;                                 05864000
        end#,                                                           05865000
                                                                        05866000
    dequeue'process =                                                   05867000
      Lock'Owner := Lock'Head'Q;                                        05868000
      if (Lock'Owner <> 0) then                                         05869000
        begin                                                           05870000
          Lock'Head'Q := pcb(head'pcb'iqptr);                           05871000
          if (Lock'Head'Q = 0) then                                     05872000
            Lock'Tail'Q := Lock'Head'Q;                                 05873000
          Lock'Q'Len := Lock'Q'Len - 1;                                 05874000
        end#;                                                           05875000
                                                                        05876000
                                                                        05877000
  integer LockWord = DB + 4;   << 4 word lock >>                        05878000
                                                                        05879000
$IF X5=ON                                                               05880000
  integer Lock'Owner    = LockWord + 0,                                 05881000
          Lock'Head'Q   = LockWord + 1,                                 05882000
          Lock'Tail'Q   = LockWord + 2,                                 05883000
          Lock'Q'Len    = LockWord + 3;                                 05884000
                                                                        05885000
  define  Lock'Owner'pin      = Lock'Owner / pcbsize#,                  05886000
          awaken'next'process = unimpede(Lock'Owner)#,                  05887000
          curr'process        = absolute(cpcb)#,                        05888000
          curr'pcb'iqptr      = absolute(cpcb) + pcb'iqptr#,            05889000
          head'pcb'iqptr      = Lock'Head'Q    + pcb'iqptr#,            05890000
          tail'pcb'iqptr      = Lock'Tail'Q    + pcb'iqptr#;            05891000
                                                                        05892000
$IF X5=OFF                                                              05893000
  integer Lock'Ptrs           = LockWord + 1;                           05894000
                                                                        05895000
  define  Lock'Owner          = LockWord.(0:8)#,                        05896000
          Lock'Owner'pin      = LockWord.(0:8)#,                        05897000
          Lock'Q'Len          = LockWord.(8:8)#,                        05898000
          Lock'Head'Q         = Lock'Ptrs.(8:8)#,                       05899000
          Lock'Tail'Q         = Lock'Ptrs.(0:8)#,                       05900000
          awaken'next'process = unimpede(Lock'Owner*pcbsize)#,          05901000
          curr'process        = curpin#,                                05902000
          curr'pcb'iqptr      = curr'process * pcbsize + pcb'iqptr#,    05903000
          head'pcb'iqptr      = Lock'Head'Q  * pcbsize + pcb'iqptr#,    05904000
          tail'pcb'iqptr      = Lock'Tail'Q  * pcbsize + pcb'iqptr#;    05905000
                                                                        05906000
$IF                                                         <<00036>>   05907000
                                                                        05908000
  integer array DictHashTable(*) = DB +8;                               05909000
                                                                        05910000
  equate Dict'HeaderSize = 8,  << obtain/release need four words >>     05911000
         NumHash'Buckets = 95; << same hash function as USL >>          05912000
                                                                        05913000
  << DictEntry structure >>                                             05914000
  equate NameIndex = 1,  << offset to 16 byte array >>                  05915000
         NameLength = 8, << word length of name array >>                05916000
         DataIndex = 9,  << offset to 7 word array >>                   05917000
         PortIdIndex = 9,  << PortId is first two words of data >>      05918000
         DataLength = 7, << length of word array >>                     05919000
         Dict'EntrySize = 16;  << length of total entry >>              05920000
                                                                        05921000
  subroutine free(entry'ptr);                                           05922000
    value entry'ptr;                                                    05923000
    integer pointer entry'ptr;                                          05924000
    begin                                                               05925000
    entry'ptr := 0;  << next link ptr := nil >>                         05926000
    if @Dict'PoolHead <> 0 then                                         05927000
      begin  << free pool not empty >>                                  05928000
      @Dict'PoolTail := Dict'PoolTail := @entry'ptr;                    05929000
      end                                                               05930000
    else                                                                05931000
      begin  << free pool empty, shouldn't happen >>                    05932000
      @Dict'PoolHead := @Dict'PoolTail := @entry'ptr;                   05933000
      end;                                                              05934000
    end;   << free >>                                                   05935000
                                                                        05936000
comment:                                                                05937000
   Locks the port dictionary semaphore by queueing the process          05938000
   to the resource words.  Returns TRUE if process already              05939000
   had the semaphore, otherwise FALSE.                                  05940000
;                                                                       05941000
logical subroutine lock;                                                05942000
begin                                                                   05943000
pdisable;                                                               05944000
if (Lock'Owner = curr'process) then                         <<00036>>   05945000
  begin                        << caller already has the semaphore >>   05946000
    penable;                                                            05947000
    lock := TRUE;                                                       05948000
  end                                                                   05949000
else                                                                    05950000
  begin                                                                 05951000
    if (Lock'Owner = 0) then                                            05952000
      begin << no processes currently have the semaphore >>             05953000
        Lock'Owner := curr'process;                                     05954000
        penable;                                                        05955000
      end                                                               05956000
   else                                                                 05957000
      begin                    << semaphore locked - queue to PCBs >>   05958000
        queue'process;                                      <<00036>>   05959000
        impaired (Lock'Owner'pin , @LockWord, FALSE);                   05960000
      end;                                                              05961000
   lock := FALSE;                                                       05962000
   end;                                                                 05963000
end;                                                                    05964000
                                                                        05965000
comment:                                                                05966000
   Releases the semaphore if previous lock is FALSE                     05967000
   Does nothing if previous lock is TRUE.                               05968000
;                                                                       05969000
subroutine unlock (prev'lock);                                          05970000
value              prev'lock;                                           05971000
logical            prev'lock;                                           05972000
begin                                                                   05973000
if prev'lock then                                                       05974000
  return; << caller had semaphore locked when procedure called >>       05975000
                                                                        05976000
pdisable;                                                               05977000
Lock'Owner := 0;                                                        05978000
if (Lock'head'q <> 0) and (Lock'tail'q <> 0) then                       05979000
  begin  << other processes are waiting >>                              05980000
    dequeue'process;                                                    05981000
    awaken'next'process;                                                05982000
  end;                                                                  05983000
penable;                                                                05984000
end;                                                                    05985000
                                                                        05986000
                                                                        05987000
                                                                        05988000
  subroutine DictExit(code);                                            05989000
    value code;                                                         05990000
    integer code;                                                       05991000
    begin                                                               05992000
    if @DictEntry <> 0 then free(DictEntry);                            05993000
  unlock(OldState);                                         <<00034>>   05994000
    exchangedb(Old'DST);                                                05995000
    Result := code;                                                     05996000
    asmb( exit 3);  << bail out of procedure >>                         05997000
    end;  << DictExit >>                                                05998000
                                                                        05999000
  subroutine DictHash;                                                  06000000
    begin                                                               06001000
    << NOTE: This is the same hash funtion as USL and SL files. >>      06002000
                                                                        06003000
    length := integer(BName).(12:4);  << first char is BName length >>  06004000
    tos := length&lsl(8) + integer(BName(1));                           06005000
    if length = 1                                                       06006000
      then asmb( dup )                                                  06007000
      else tos := integer(BName(length-1))&lsl(8) +                     06008000
                  integer(BName(x:=x+1));                               06009000
    tos := 95;                                                          06010000
    asmb( ldiv,delb );                                                  06011000
    HashValue := tos;                                                   06012000
    end;   << DictHash >>                                               06013000
                                                                        06014000
<< set the function code based upon entry point called >>               06015000
                                                                        06016000
<<DictAdd>>  function := 0;  goto start;                                06017000
DictUpdate : function := 1;  goto start;                                06018000
DictFind   : function := 2;  goto start;                                06019000
DictDelete : function := 3;  goto start;                                06020000
DictSend   : function := 4;<<goto start;>>                              06021000
                                                                        06022000
<< common code for all entry points >>                                  06023000
start :                                                                 06024000
  turn'traps'off;                                                       06025000
  DictHash;  << sets HashValue using BName>>                            06026000
  push( DL );   << calc. DL relative addresses for MVLB instr >>        06027000
  asmb( neg,dup );                                                      06028000
  DL'Name := tos + @Name;                                               06029000
  DL'Data := tos + @Data;                                               06030000
                                                                        06031000
  Old'DST := exchangedb(Port'Dict'DSTN);                                06032000
OldState := Lock;                                           <<00034>>   06033000
                                                                        06034000
  << allocate a Dict. entry bucket as a scratch area >>                 06035000
                                                                        06036000
  @DictEntry := @Dict'PoolHead;                                         06037000
  if = then                                                             06038000
    suddendeath(badport);  << shouldn't happen >>                       06039000
  @Dict'PoolHead := Dict'PoolHead;                                      06040000
  if = then                                                             06041000
    @Dict'PoolTail := 0;  << free pool is now empty >>                  06042000
  DictEntry := 0;  << Next link ptr >>                                  06043000
  @bptr0 := @DictEntry(NameIndex)&lsl(1);  << for byte compare >>       06044000
                                                                        06045000
  if Old'DST = 0 then                                                   06046000
    begin  << move from stack to DictDSTN >>                            06047000
    << move Name from stack to DictDST >>                               06048000
    tos := @DictEntry(NameIndex);                                       06049000
    tos := DL'Name;                                                     06050000
    tos := NameLength;                                                  06051000
    asmb( mvlb 3 );                                                     06052000
                                                                        06053000
    if function < 2 then                                                06054000
      begin  << Add and Update >>                                       06055000
      << move Data from stack to DictDST >>                             06056000
      tos := @DictEntry(DataIndex);                                     06057000
      tos := DL'Data;                                                   06058000
      tos := DataLength;                                                06059000
      asmb( mvlb 3 );                                                   06060000
      end;                                                              06061000
    end                                                                 06062000
  else                                                                  06063000
    begin  << move from XDS to DictDSTN >>                              06064000
<<+*+>> << NOTE  This will have to change when "fast" exchangedb >>     06065000
<<+*+>> <<        is called, because the "from" DST may be absent >>    06066000
    << move Name from XDS to DictDST >>                                 06067000
    tos := @DictEntry(NameIndex);                                       06068000
    tos := Old'DST;                                                     06069000
    tos := @Name;                                                       06070000
    tos := NameLength;                                                  06071000
    asmb( mfds 4 );                                                     06072000
                                                                        06073000
    if function < 2 then                                                06074000
      begin  << Add and Update >>                                       06075000
      << move Data from XDS to DictDST >>                               06076000
      tos := @DictEntry(DataIndex);                                     06077000
      tos := Old'DST;                                                   06078000
      tos := @Data;                                                     06079000
      tos := DataLength;                                                06080000
      asmb( mfds 4 );                                                   06081000
      end;                                                              06082000
    end;                                                                06083000
                                                                        06084000
    tos := Old'DST;                                                     06085000
  << search for a match >>                                              06086000
  @PrevBucket := @DictHashTable(HashValue);                             06087000
  @HashBucket := PrevBucket;                                            06088000
  while <> do                                                           06089000
    begin                                                               06090000
    @bptr1 := @HashBucket(NameIndex)&lsl(1);                            06091000
    if bptr0 = bptr1,(length+1) then goto found;                        06092000
    << not found, continue search >>                                    06093000
    @PrevBucket := @HashBucket;                                         06094000
    @HashBucket := HashBucket;  << Next link ptr >>                     06095000
    end;                                                                06096000
                                                                        06097000
  << didn't find a match >>                                             06098000
  if function = 0 then                                                  06099000
    begin  << add >>                                                    06100000
    if @Dict'PoolHead = 0 then                                          06101000
      begin  << try to expand DST >>                                    06102000
      << The DictDST is expanded only on DictAdds.  This is done so     06103000
         that the error "table'full" will be returned only on Add.      06104000
         All the other entry points get an entry durring processing,    06105000
         but release the entry before exiting.  Therefore, a "full"     06106000
         DictDST always has one free entry. >>                          06107000
      oldsize := CurrentDSTSize;                                        06108000
      newsize := altdsegsize(Port'Dict'DSTN, 1024);                     06109000
      if <> then                                                        06110000
        begin  << expansion failed, bail out >>                         06111000
        DictExit(table'full);  << return to caller >>                   06112000
        end;                                                            06113000
                                                                        06114000
      @Dict'element := oldsize;                                         06115000
      @Dict'PoolHead := @Dict'element;                                  06116000
      while @Dict'element < newsize - 2*Dict'EntrySize do   <<00018>>   06117000
        begin                                                           06118000
        @Dict'element := Dict'element := @Dict'element + Dict'EntrySize;06119000
        end;                                                            06120000
      @Dict'PoolTail := @Dict'element;                                  06121000
      Dict'element := 0;                                    <<00018>>   06122000
      CurrentDSTSize := @Dict'element + Dict'EntrySize;                 06123000
      end;  << DST expansion >>                                         06124000
                                                                        06125000
    PrevBucket := @DictEntry;  << link entry to tail >>                 06126000
    @DictEntry := 0;  << so DictExit doesn't free it >>                 06127000
    DictExit(ok);                                                       06128000
    end                                                                 06129000
  else                                                                  06130000
    begin  << update, find, delete, or send >>                          06131000
    DictExit(not'found);                                                06132000
    end;                                                                06133000
                                                                        06134000
found :   << found a match >>                                           06135000
  case function of                                                      06136000
    begin                                                               06137000
                                                                        06138000
    begin  << add >>                                                    06139000
    DictExit(already'exists);                                           06140000
    end;                                                                06141000
                                                                        06142000
    begin  << update >>                                                 06143000
    move HashBucket(DataIndex) := DictEntry(DataIndex),(DataLength);    06144000
    end;                                                                06145000
                                                                        06146000
    begin  << find >>                                                   06147000
    if Old'DST = 0 then                                                 06148000
      begin  << move Data from DictDST to stack >>                      06149000
      tos := DL'Data;                                                   06150000
      tos := @HashBucket(DataIndex);                                    06151000
      tos := DataLength;                                                06152000
      asmb( mvbl 3 );                                                   06153000
      end                                                               06154000
    else                                                                06155000
      begin  << move Data from DictDST to XDS >>                        06156000
<<+*+>> << NOTE  This will have to change when "fast" exchangedb >>     06157000
<<+*+>> <<        is called, because the "from" DST may be absent >>    06158000
      tos := Old'DST;                                                   06159000
      tos := @Data;                                                     06160000
      tos := @HashBucket(DataIndex);                                    06161000
      tos := DataLength;                                                06162000
      asmb( mtds 4 );                                                   06163000
      end;                                                              06164000
    end;                                                                06165000
                                                                        06166000
    begin  << delete >>                                                 06167000
    PrevBucket := HashBucket;  << delink entry >>                       06168000
    free(HashBucket);                                                   06169000
    end;                                                                06170000
                                                                        06171000
    begin  << send >>                                                   06172000
<< NOTE: DictSend expects subqueue to be specified in word >>           06173000
<<       zero of Data.  This is NOT consistant with the    >>           06174000
<<       'regular' Send primitives, which have a parameter >>           06175000
<<       to select the subqueue.  This was done to fit into>>           06176000
<<       the alternate entry point technique used by the   >>           06177000
<<       other dictionary routines.                        >>           06178000
                                                                        06179000
    if Old'DST = 0 then                                                 06180000
      begin  << send from stack >>                                      06181000
      push(q,dl);  << calc. Q rel. Data address >>                      06182000
      asmb( xch,sub );   << Q rel DL >>                                 06183000
      @Q'Data := tos + DL'Data;                                         06184000
      PortId0 := HashBucket(PortIdIndex);                               06185000
      PortID1 := hashBucket(PortIdIndex +1);                            06186000
      Send'Q(PortId,QM0array(@Q'Data),Q'Data);                          06187000
      end                                                               06188000
    else                                                                06189000
      begin  << send from XDS >>                                        06190000
<<+*+>> << ?????  This may have to change when "fast" exchangedb >>     06191000
<<+*+>> <<        is called, because the "from" DST may be absent >>    06192000
      PortId0 := HashBucket(PortIdIndex);                               06193000
      PortID1 := hashBucket(PortIdIndex +1);                            06194000
      exchangedb(Old'DST);                                              06195000
      Send'DB(PortId,Data,Data);                                        06196000
      exchangedb(Port'Dict'DSTN);                                       06197000
      end;                                                              06198000
    end;                                                                06199000
                                                                        06200000
    end;   << end case >>                                               06201000
                                                                        06202000
  DictExit(ok);  << Update/Find/Delete/Send >>                          06203000
                                                                        06204000
  end;  << DictAdd/Update/Find/Delete/Send >>                           06205000
$page                                                                   06206000
$PAGE "Byte Move Routines"                                              06207000
                                                                        06208000
Procedure MTDS (SourceDST,DSToffset,Buffer,Count);                      06209000
Value SourceDST,DSToffset,Count;                                        06210000
Integer SourceDST,DSToffset,Count;                                      06211000
Integer array Buffer;                                                   06212000
OPTION PRIVILEGED,UNCALLABLE<<,UNREADABLE>>;                            06213000
COMMENT:   This routine will move data to a specified data              06214000
           segment.  It is heavily dependent on structures              06215000
           in MPE and should be rewritten for use on VCF.               06216000
                                                                        06217000
           Status return:                                               06218000
           CCE - Successful completion.                                 06219000
           CCL - Invalid segment number or move count.                  06220000
           CCG - Invalid starting address or bounds violation;          06221000
                                                                        06222000
Begin                                                                   06223000
Integer Status = Q-1;                                                   06224000
Integer pointer PXglobal;                                               06225000
Integer DLreg,DSTlength,LowerLimit,Qreg,TargetDST,UpperLimit;           06226000
                                                                        06227000
Status.CCF := CCE;          << Assume successful completion >>          06228000
                                                                        06229000
DSTlength := DST'size (SourceDST);                                      06230000
If <> OR Count < 0 then                                                 06231000
   Begin                                                                06232000
                                                                        06233000
<< Caller specified an invalid segment number or move count. >>         06234000
                                                                        06235000
   Status.CCF := CCL;                                                   06236000
   Return;                                                              06237000
   End;                                                                 06238000
                                                                        06239000
If DSToffset < 0 OR DSToffset+Count > DSTlength then                    06240000
   Begin                                                                06241000
                                                                        06242000
<< Starting address/move count will cause a bounds violation >>         06243000
<< in the specified source data segment, so return an error. >>         06244000
                                                                        06245000
   Status.CCF := CCG;                                                   06246000
   Return;                                                              06247000
   End;                                                                 06248000
                                                                        06249000
TargetDST := Wheres'DB;                                                 06250000
If = then                                                               06251000
   Begin                                       << At stack  >>          06252000
   PUSH (Q,DL);                                                         06253000
   @PXglobal := TOS-PS0(-1);                                            06254000
   LowerLimit := -PXglobal(1);                                          06255000
   UpperLimit := TOS-%10;                                               06256000
   End                                                                  06257000
Else                                                                    06258000
   If > then                                                            06259000
      Begin                                    << At an XDS >>          06260000
      LowerLimit := 0;                                                  06261000
      UpperLimit := DST'size (TargetDST)-1;                             06262000
      If <> then Return;                                                06263000
      End                                                               06264000
   Else                                                                 06265000
      Begin                                    << At ABS DB >>          06266000
      LowerLimit := 0;                                                  06267000
      UpperLimit := %377;                                               06268000
      End;                                                              06269000
                                                                        06270000
If @Buffer < LowerLimit OR @Buffer+Count-1 > UpperLimit then            06271000
   Begin                                                                06272000
                                                                        06273000
<< Starting address/move count will cause a bounds violation >>         06274000
<< at the caller's current DB setting, so return an error.   >>         06275000
                                                                        06276000
   Status.CCF := CCG;                                                   06277000
   Return;                                                              06278000
   End;                                                                 06279000
                                                                        06280000
TOS := SourceDST;                         << Segment number >>          06281000
TOS := DSToffset;                         << Seg-rel offset >>          06282000
TOS := @Buffer;                           << DB-rel source  >>          06283000
TOS := Count;                             << Words to move  >>          06284000
ASMB (MTDS 4);                                                          06285000
End;                                                                    06286000
                                                                        06287000
$PAGE                                                                   06288000
                                                                        06289000
Procedure MFDS (Buffer,TargetDST,DSToffset,Count);                      06290000
Value TargetDST,DSToffset,Count;                                        06291000
Integer TargetDST,DSToffset,Count;                                      06292000
Integer array Buffer;                                                   06293000
OPTION PRIVILEGED,UNCALLABLE<<,UNREADABLE>>;                            06294000
COMMENT:   This routine will move data from a specified data            06295000
           segment.  It is heavily dependent on structures              06296000
           in MPE and should be rewritten for use on VCF.               06297000
                                                                        06298000
           Status return:                                               06299000
           CCE - Successful completion.                                 06300000
           CCL - Invalid segment number or move count.                  06301000
           CCG - Invalid starting address or bounds violation;          06302000
                                                                        06303000
Begin                                                                   06304000
Integer Status = Q-1;                                                   06305000
Integer pointer PXglobal;                                               06306000
Integer DLreg,DSTlength,LowerLimit,Qreg,SourceDST,UpperLimit;           06307000
                                                                        06308000
Status.CCF := CCE;          << Assume successful completion >>          06309000
                                                                        06310000
DSTlength := DST'size (TargetDST);                                      06311000
If <> OR Count < 0 then                                                 06312000
   Begin                                                                06313000
                                                                        06314000
<< Caller specified an invalid segment number or move count. >>         06315000
                                                                        06316000
   Status.CCF := CCL;                                                   06317000
   Return;                                                              06318000
   End;                                                                 06319000
                                                                        06320000
If DSToffset < 0 OR DSToffset+Count > DSTlength then                    06321000
   Begin                                                                06322000
                                                                        06323000
<< Starting address/move count will cause a bounds violation >>         06324000
<< in the specified target data segment, so return an error. >>         06325000
                                                                        06326000
   Status.CCF := CCG;                                                   06327000
   Return;                                                              06328000
   End;                                                                 06329000
                                                                        06330000
SourceDST := Wheres'DB;                                                 06331000
If = then                                                               06332000
   Begin                                       << At stack  >>          06333000
   PUSH (Q,DL);                                                         06334000
   @PXglobal := TOS-PS0(-1);                                            06335000
   LowerLimit := -PXglobal(1);                                          06336000
   UpperLimit := TOS-%10;                                               06337000
   End                                                                  06338000
Else                                                                    06339000
   If > then                                                            06340000
      Begin                                    << At an XDS >>          06341000
      LowerLimit := 0;                                                  06342000
      UpperLimit := DST'size (SourceDST)-1;                             06343000
      If <> then Return;                                                06344000
      End                                                               06345000
   Else                                                                 06346000
      Begin                                    << At ABS DB >>          06347000
      LowerLimit := 0;                                                  06348000
      UpperLimit := %377;                                               06349000
      End;                                                              06350000
                                                                        06351000
If @Buffer < LowerLimit OR @Buffer+Count-1 > UpperLimit then            06352000
   Begin                                                                06353000
                                                                        06354000
<< Starting address/move count will cause a bounds violation >>         06355000
<< at the caller's current DB setting, so return an error.   >>         06356000
                                                                        06357000
   Status.CCF := CCG;                                                   06358000
   Return;                                                              06359000
   End;                                                                 06360000
                                                                        06361000
TOS := @Buffer;                           << DB-rel target  >>          06362000
TOS := TargetDST;                         << Segment number >>          06363000
TOS := DSToffset;                         << Seg-rel offset >>          06364000
TOS := Count;                             << Words to move  >>          06365000
ASMB (MFDS 4);                                                          06366000
End;                                                                    06367000
                                                                        06368000
$PAGE                                                                   06369000
                                                                        06370000
Comment                                                                 06371000
                                                                        06372000
                                                                        06373000
         Sorc  Dest  Len                                                06374000
         ====  ====  ===                                                06375000
                                                                        06376000
                                                                        06377000
         Word ------------->  |xx|xx|xx|  |                             06378000
                     Even                                               06379000
               Word ------->  |xx|xx|xx|  |                             06380000
                                                                        06381000
                                                                        06382000
                                                                        06383000
         Word ------------->  |xx|xx|xx|x |                             06384000
                     Odd                                                06385000
               Word ------->  |xx|xx|xx|x |                             06386000
                                                                        06387000
                                                                        06388000
                                                                        06389000
         Word ------------->  |xx|xx|xx|  |                             06390000
                     Even      \        \                               06391000
               Byte ------->  | x|xx|xx|x |                             06392000
                                                                        06393000
                                                                        06394000
                                                                        06395000
         Word ------------->  |xx|xx|xx|x |                             06396000
                     Odd       \         \                              06397000
               Byte ------->  | x|xx|xx|xx|                             06398000
                                                                        06399000
                                                                        06400000
                                                                        06401000
         Byte ------------->  | x|xx|xx|x |                             06402000
                     Even      /        /                               06403000
               Word ------->  |xx|xx|xx|  |                             06404000
                                                                        06405000
                                                                        06406000
                                                                        06407000
         Byte ------------->  | x|xx|xx|xx|                             06408000
                     Odd       /         /                              06409000
               Word ------->  |xx|xx|xx|x |                             06410000
                                                                        06411000
                                                                        06412000
                                                                        06413000
         Byte ------------->  | x|xx|xx|x |                             06414000
                     Even                                               06415000
               Byte ------->  | x|xx|xx|x |                             06416000
                                                                        06417000
                                                                        06418000
                                                                        06419000
         Byte ------------->  | x|xx|xx|xx|                             06420000
                     Odd                                                06421000
               Byte ------->  | x|xx|xx|xx|                             06422000
;                                                                       06423000
$PAGE                                                                   06424000
procedure mbds(dest'dst,dest'addr,sorc'dst,sorc'addr,len);              06425000
   value       dest'dst,dest'addr,sorc'dst,sorc'addr,len;               06426000
   integer     dest'dst,          sorc'dst;                             06427000
   logical     dest'addr,                  sorc'addr,len;               06428000
   option privileged,uncallable;                                        06429000
begin                                                                   06430000
   entry                                                                06431000
      mbds';                                                            06432000
   integer                                                              06433000
      save'dst = dest'dst,                                              06434000
      ilen     = len;                                                   06435000
   double                                                               06436000
      dest'loc = dest'dst,                                              06437000
      sorc'loc = sorc'dst;                                              06438000
   byte pointer                                                         06439000
      dest'bp  = dest'addr;                                             06440000
                                                                        06441000
   logical                                                              06442000
      at'sysdb   = q+1;                                                 06443000
   integer                                                              06444000
      at'sysdbi  = at'sysdb,                                            06445000
      save'firstb= at'sysdb+1,         << re-usable loc >>              06446000
      save'lastb = save'firstb+1,      << unused dest'dst here >>       06447000
      save'byte  = save'lastb;                                          06448000
                                                                        06449000
   tos:=dst'maxp;                      << dst'max >>                    06450000
   if s0  < dest'dst then go bad'dst;  << illegal dst >>                06451000
   if tos < sorc'dst then go bad'dst;  << illegal dst >>                06452000
   tos:=dest'dst;                                                       06453000
   if <= then go bad'dst;              << illegal dst >>                06454000
   tos:=dst(tos&dst'entlen)&dst'seglen;  << dest'dstsz >>               06455000
   if = then go bad'dst;               << unassigned dst >>             06456000
   tos:=sorc'dst;                                                       06457000
   if <= then go bad'dst;              << illegal dst >>                06458000
   tos:=dst(tos&dst'entlen)&dst'seglen;  << sorc'dstsz >>               06459000
   if = then                           << unassigned dst >>             06460000
   begin                                                                06461000
bad'dst:                                                                06462000
      qstat.ccf:=ccl;                                                   06463000
      go exit;                                                          06464000
   end;                                                                 06465000
   lx:=len+1;                          << must use logical arith. >>    06466000
   if = then go out'of'bounds;         << greater than abs. max >>      06467000
   tos:=(sorc'addr+lx)&lsr(1);         << x = len+1 >>                  06468000
   if carry then go out'of'bounds;     << sorc dst overflow >>          06469000
   if tos < tos then go out'of'bounds; << sorc'dstsz < tos? >>          06470000
   tos:=(dest'addr+lx)&lsr(1);         << x = len+1 >>                  06471000
   if carry then go out'of'bounds;     << dest dst overflow >>          06472000
   if tos < tos then                   << dest'dstsz < tos? >>          06473000
   begin                                                                06474000
out'of'bounds:                                                          06475000
      qstat.ccf:=ccg;                                                   06476000
      go exit;                                                          06477000
   end;                                                                 06478000
mbds':                                                                  06479000
   qstat'cce;                          << qstat.ccf:=cce >>             06480000
   tos:=0d;                            << at'sysdb, save'firstb >>      06481000
   tos:=dest'loc;                      << dst, addr >>                  06482000
   tos:=tos&lsr(1);                    << word address >>               06483000
   tos:=sorc'loc;                      << dst, addr >>                  06484000
   tos:=tos&lsr(1);                    << word address >>               06485000
   x:=ilen;                                                             06486000
   tos:=(x+1)&lsr(1);                  << word count >>                 06487000
   if = then go exit;                  << no move >>                    06488000
   if sorc'addr then                                                    06489000
   begin                                                                06490000
      switch'db(dest'dst);                                              06491000
      if dest'addr then                                                 06492000
         if lx then                    << x = len >>                    06493000
         begin     << sorc: byte   dest: byte   len: odd  >>            06494000
            save'byte:=dest'bp(-1);                                     06495000
            asmb(mfds);                                                 06496000
            dest'bp(x):=tos;           << x=-1; tos=save'byte >>        06497000
         end else                                                       06498000
         begin     << sorc: byte   dest: byte   len: even >>            06499000
            @dest'bp:=@dest'bp-1;                                       06500000
            save'firstb:=dest'bp;                                       06501000
            tos:=tos+1;                << need extra word >>            06502000
            save'lastb:=dest'bp(x:=x+1);<< x:=x+1 = len+1 >>            06503000
            asmb(mfds);                                                 06504000
            dest'bp(x):=tos;           << x=len+1; tos=save'lastb >>    06505000
            dest'bp:=tos;              << tos=save'firstb >>            06506000
         end                                                            06507000
      else                                                              06508000
         if lx then                    << x = len >>                    06509000
         begin     << sorc: byte   dest: word   len: odd  >>            06510000
            save'lastb:=dest'bp(x);    << x = len >>                    06511000
            asmb(mfds);                                                 06512000
            tos:=dest'addr;                                             06513000
            tos:=s0+1;                 << dest'addr(1) >>               06514000
            move *:=*,(x);             << dest:=dest(1),(len) >>        06515000
            dest'bp(x):=tos;           << x=len; tos=save'lastb >>      06516000
         end else                                                       06517000
         begin     << sorc: byte   dest: word   len: even >>            06518000
            asmb(mfds 1);              << leave dst, addr's on stack >> 06519000
            save'lastb:=dest'bp(x:=x-1);<< x:=x-1 = len-1 >>            06520000
            tos:=dest'addr;                                             06521000
            tos:=s0+1;                 << dest'addr(1) >>               06522000
            move *:=*,(x:=x-1);        << dest:=dest(1),(len-2) >>      06523000
            s2:=s2-1;                  << back up dest'wp >>            06524000
            tos:=1;                                                     06525000
            asmb(mfds);                << get last byte >>              06526000
            tos:=dest'bp(x);           << x = len-2 >>                  06527000
            dest'bp(x):=save'lastb;    << next-to-last >>               06528000
            dest'bp(x:=x+1):=tos;      << last byte >>                  06529000
         end;                                                           06530000
      restore'db;                                                       06531000
exit:                                                                   06532000
      return;                                                           06533000
   end;                                                                 06534000
   begin                                                                06535000
      if dest'addr then                                                 06536000
      begin        << sorc: word   dest: byte   len: any  >>            06537000
         switch'db(dest'dst);                                           06538000
         @dest'bp:=@dest'bp-1;                                          06539000
         save'byte:=dest'bp;                                            06540000
         asmb(mfds);                                                    06541000
         move dest'bp(x):=dest'bp(x:=x-1),(not lx);                     06542000
         dest'bp:=tos;                 << tos=save'byte >>              06543000
         restore'db;                                                    06544000
         return;                                                        06545000
      end;                                                              06546000
         if lx then                    << x = len >>                    06547000
         begin     << sorc: word   dest: word   len: odd  >>            06548000
            switch'db(dest'dst);                                        06549000
            save'lastb:=dest'bp(x);    << x = len >>                    06550000
            asmb(mfds);                                                 06551000
            dest'bp(x):=tos;           << x=len; tos=save'lastb >>      06552000
            restore'db;                                                 06553000
            return;                                                     06554000
         end;                                                           06555000
         asmb(mds);<< sorc: word   dest: word   len: even >>            06556000
   end;                                                                 06557000
end;               << mbds >>                                           06558000
                                                                        06559000
$PAGE                                                                   06560000
                                                                        06561000
procedure mbfds(dest'addr,sorc'dst,sorc'addr,len);                      06562000
   value        dest'addr,sorc'dst,sorc'addr,len;                       06563000
   integer                sorc'dst;                                     06564000
   logical      dest'addr,         sorc'addr,len;                       06565000
   option privileged,uncallable;                                        06566000
begin                                                                   06567000
   entry                                                                06568000
      mbfds';                                                           06569000
   integer                                                              06570000
      ilen     = len;                                                   06571000
   double                                                               06572000
      sorc'loc = sorc'dst;                                              06573000
   byte pointer                                                         06574000
      dest'bp  = dest'addr;                                             06575000
                                                                        06576000
   logical                                                              06577000
      mpe5       = q+2;                                                 06578000
   integer                                                              06579000
      save'firstb= q+1,                << re-usable loc's >>            06580000
      save'lastb = save'firstb+1,      << "             " >>            06581000
      save'byte  = save'lastb;                                          06582000
                                                                        06583000
   asmb(dzro,deca);                    << filler; mpe5:=true >>         06584000
   tos:=abs(cpcb)+2;                   << current pcb entry >>          06585000
   if pcb'entlenp = mpe4'entlen then                                    06586000
   begin                                                                06587000
      tos:=abs(pcbb);                  << convert to pcb relative >>    06588000
      asmb(sub,incb);                  << mpe5:=false >>                06589000
   end;                                                                 06590000
   tos:=pcb(tos);                     << get pcb02 entry >>             06591000
   if < then go bad'dst;               << absolute db >>                06592000
   tos:=sorc'dst;                                                       06593000
   if <= then go bad'dst;              << invalid dst >>                06594000
   if s0 > dst'maxp then go bad'dst;   << invalid dst >>                06595000
   tos:=dst(tos&dst'entlen)&dst'seglen;  << sorc'dstsz >>               06596000
   if = then                           << unassigned dst >>             06597000
   begin                                                                06598000
bad'dst:                                                                06599000
      qstat.ccf:=ccl;                                                   06600000
      go exit;                                                          06601000
   end;                                                                 06602000
   lx:=len+1;                          << must use logical arith. >>    06603000
   if = then go out'of'bounds;         << greater than abs. max >>      06604000
   tos:=(sorc'addr+lx)&lsr(1);         << x = len+1 >>                  06605000
   if carry then go out'of'bounds;     << sorc dst overflow >>          06606000
   if tos < tos then go out'of'bounds; << sorc'dstsz < tos? >>          06607000
   if mpe5 then tos:=tos.(2:14) else tos:=tos.(1:10);                   06608000
   if <> then                                                           06609000
   begin                               << XDS <> 0 => Split stack >>    06610000
      tos:=tos&dst'entlen;             << dest'dst# * dst'entlen >>     06611000
      tos:=(dest'addr+lx)&lsr(1);      << x = len+1 >>                  06612000
      if carry then go out'of'bounds;  << dest dst overflow >>          06613000
      asmb(stbx,delb);                 << x := dst# * dst'entlen >>     06614000
      if tos > dst(x) then go out'of'bounds;                            06615000
      tos:=dest'addr&lsr(1);           << word address >>               06616000
   end else                                                             06617000
   begin                               << at stack >>                   06618000
      tos:=dest'addr&lsr(1);           << word address (dest'wp) >>     06619000
      asmb(delb,dup);                  << del dst#; copy dest'wp >>     06620000
      tos:=dest'addr+lx;               << x = len+1 >>                  06621000
      if carry then go out'of'bounds;  << dest dst overflow >>          06622000
      if tos&asr(1) > @dest'addr then go out'of'bounds;                 06623000
      push(s);                                                          06624000
      if tos > tos then tos.(0:1):=1;  << db-minus >>                   06625000
      push(dl);                                                         06626000
      if tos-ps0(-1) > s1 then         << dest dst underflow >>         06627000
      begin                                                             06628000
out'of'bounds:                                                          06629000
         qstat.ccf:=ccg;                                                06630000
         go exit;                                                       06631000
      end;                                                              06632000
   end;                                                                 06633000
   go do'mbfds;                                                         06634000
mbfds':                                                                 06635000
   tos:=0d;                            << save'firstb, save'lastb >>    06636000
   tos:=dest'addr&lsr(1);              << word address >>               06637000
   push(s,z,dl,db,sbank);                                               06638000
   asmb(delb,cmp);                     << del db; only need dbbank >>   06639000
   if = then                           << sbank = dbbank? >>            06640000
   begin                                                                06641000
      asmb(zrox,xch);                  << xch z,dl >>                   06642000
      if tos <= x <= tos then          << at stack >>                   06643000
      begin                                                             06644000
         if tos < s1 then tos.(0:1):=1;<< db-minus >>                   06645000
      end else del;                    << clean up stack >>             06646000
   end else asmb(ddel,del);            << "            " >>             06647000
do'mbfds:                                                               06648000
   qstat'cce;                          << qstat.ccf:=cce >>             06649000
   tos:=sorc'loc;                      << dst, addr >>                  06650000
   tos:=tos&lsr(1);                    << word address >>               06651000
   x:=ilen;                                                             06652000
   tos:=(x+1)&lsr(1);                  << word count >>                 06653000
   if = then go exit;                  << no move >>                    06654000
   if sorc'addr then                                                    06655000
   begin                                                                06656000
      if dest'addr then                                                 06657000
      begin                                                             06658000
         @dest'bp:=@dest'bp-1;                                          06659000
         if lx then                    << x = len >>                    06660000
         begin     << sorc: byte   dest: byte   len: odd  >>            06661000
            save'byte:=dest'bp;                                         06662000
            asmb(mfds);                                                 06663000
            dest'bp:=tos;              << tos=save'byte >>              06664000
exit:                                                                   06665000
            return;                                                     06666000
         end;                                                           06667000
         begin     << sorc: byte   dest: byte   len: even >>            06668000
            tos:=tos+1;                << need extra word >>            06669000
            save'lastb:=dest'bp(x:=x+1);<< x:=x+1 = len+1 >>            06670000
            save'firstb:=dest'bp;                                       06671000
            asmb(mfds);                                                 06672000
            dest'bp(x):=tos;           << x=len+1; tos=save'lastb >>    06673000
            dest'bp:=tos;              << tos=save'firstb >>            06674000
            return;                                                     06675000
         end;                                                           06676000
      end;                                                              06677000
      begin                                                             06678000
         if lx then                    << x = len >>                    06679000
         begin     << sorc: byte   dest: word   len: odd  >>            06680000
            save'lastb:=dest'bp(x);    << x = len >>                    06681000
            asmb(mfds);                                                 06682000
            tos:=dest'addr;                                             06683000
            tos:=s0+1;                 << dest'addr(1) >>               06684000
            move *:=*,(x);             << dest:=dest(1),(len) >>        06685000
            dest'bp(x):=tos;           << x=len+1; tos=save'lastb >>    06686000
            return;                                                     06687000
         end;                                                           06688000
         begin     << sorc: byte   dest: word   len: even >>            06689000
            asmb(mfds 1);              << leave dst, addr's on stack >> 06690000
            save'lastb:=dest'bp(x:=x-1);<< x:=x-1 = len-1 >>            06691000
            tos:=dest'addr;                                             06692000
            tos:=s0+1;                 << dest'addr(1) >>               06693000
            move *:=*,(x:=x-1);        << dest:=dest(1),(len-2) >>      06694000
            s2:=s2-1;                  << back up dest'wp >>            06695000
            tos:=1;                                                     06696000
            asmb(mfds);                << get last byte >>              06697000
            tos:=dest'bp(x);           << x = len-2 >>                  06698000
            dest'bp(x):=save'lastb;    << next-to-last >>               06699000
            dest'bp(x:=x+1):=tos;      << last byte >>                  06700000
            return;                                                     06701000
         end;                                                           06702000
      end;                                                              06703000
   end;                                                                 06704000
      if dest'addr then                                                 06705000
      begin        << sorc: word   dest: byte   len: any  >>            06706000
         @dest'bp:=@dest'bp-1;                                          06707000
         save'byte:=dest'bp;                                            06708000
         asmb(mfds);                                                    06709000
         move dest'bp(x):=dest'bp(x:=x-1),(not lx);                     06710000
         dest'bp:=tos;                 << tos=save'byte >>              06711000
         return;                                                        06712000
      end;                                                              06713000
         if lx then                    << x = len >>                    06714000
         begin     << sorc: word   dest: word   len: odd  >>            06715000
            save'lastb:=dest'bp(x);    << x = len >>                    06716000
            asmb(mfds);                                                 06717000
            dest'bp(x):=tos;           << x=len; tos=save'lastb >>      06718000
            return;                                                     06719000
         end;                                                           06720000
         asmb(mfds);<< sorc: word   dest: word   len: even >>           06721000
end;                                                                    06722000
                                                                        06723000
$PAGE                                                                   06724000
                                                                        06725000
procedure mbtds(dest'dst,dest'addr,sorc'addr,len);                      06726000
   value        dest'dst,dest'addr,sorc'addr,len;                       06727000
   integer      dest'dst;                                               06728000
   logical               dest'addr,sorc'addr,len;                       06729000
   option privileged,uncallable;                                        06730000
begin                                                                   06731000
   entry                                                                06732000
      mbtds';                                                           06733000
   integer                                                              06734000
      save'dst = dest'dst,                                              06735000
      ilen     = len;                                                   06736000
   double                                                               06737000
      dest'loc = dest'dst;                                              06738000
   byte pointer                                                         06739000
      dest'bp  = dest'addr,                                             06740000
      sorc'bp  = sorc'addr;                                             06741000
                                                                        06742000
   logical                                                              06743000
      mpe5       = q+1;                                                 06744000
   integer                                                              06745000
      save'firstw= mpe5,               << re-usable loc's >>            06746000
      save'lastw = save'firstw+1,      << "             " >>            06747000
      save'word  = save'lastw;                                          06748000
   byte                                                                 06749000
      save'firstb= save'firstw,                                         06750000
      save'lastb = save'lastw;                                          06751000
   double                                                               06752000
      dest'locw  = save'lastw+1;                                        06753000
   integer pointer                                                      06754000
      dest'wp    = dest'locw+1,                                         06755000
      sorc'wp    = dest'wp+1;                                           06756000
                                                                        06757000
   asmb(dzro,decb);                    << mpe5:=true; filler >>         06758000
   tos:=dest'dst;                                                       06759000
   if <= then go bad'dst;              << invalid dst >>                06760000
   if s0 > dst'maxp then go bad'dst;   << invalid dst >>                06761000
   x:=s0&dst'entlen;                   << x:=dest'dst*dst'entlen >>     06762000
   tos:=dest'addr&lsr(1);              << dest'wp >>                    06763000
   tos:=sorc'addr&lsr(1);              << sorc'wp >>                    06764000
   tos:=dst(x)&dst'seglen;               << dest'dstsz >>               06765000
   if = then go bad'dst;               << unassigned dst >>             06766000
   tos:=abs(cpcb)+2;                   << current pcb entry >>          06767000
   if pcb'entlenp = mpe4'entlen then                                    06768000
   begin                                                                06769000
      tos:=tos-abs(pcbb);              << convert to pcb relative >>    06770000
      mpe5:=false;                                                      06771000
   end;                                                                 06772000
   tos:=pcb(tos);                     << get pcb02 entry >>             06773000
   if < then                           << absolute db >>                06774000
   begin                                                                06775000
bad'dst:                                                                06776000
      qstat.ccf:=ccl;                                                   06777000
      go exit;                                                          06778000
   end;                                                                 06779000
   lx:=len+1;                          << must use logical arith. >>    06780000
   if = then go out'of'bounds;         << greater than abs. max >>      06781000
   tos:=(dest'addr+lx)&lsr(1);         << x = len+1 >>                  06782000
   if carry then go out'of'bounds;     << dest dst overflow >>          06783000
   asmb(cab,cmp);                      << tos > dest'dstsz? >>          06784000
   if > then go out'of'bounds;         << dest dst overflow >>          06785000
   if mpe5 then tos:=tos.(2:14) else tos:=tos.(1:10);                   06786000
   if <> then                                                           06787000
   begin                               << XDS <> 0 => Split stack >>    06788000
      tos:=tos&dst'entlen;             << sorc'dst# * dst'entlen >>     06789000
      tos:=(sorc'addr+lx)&lsr(1);      << x = len+1 >>                  06790000
      if carry then go out'of'bounds;  << sorc dst overflow >>          06791000
      asmb(stbx,delb);                 << x := dst# * dst'entlen >>     06792000
      if tos > dst(x) then go out'of'bounds;                            06793000
   end else                                                             06794000
   begin                               << at stack >>                   06795000
      asmb(del,dup);                   << del dst#; copy sorc'wp >>     06796000
      tos:=sorc'addr+lx;               << x = len+1 >>                  06797000
      if carry then go out'of'bounds;  << sorc dst overflow >>          06798000
      if tos&asr(1) > @dest'dst then go out'of'bounds;                  06799000
      push(s);                                                          06800000
      if tos > tos then tos.(0:1):=1;  << db-minus >>                   06801000
      push(dl);                                                         06802000
      if tos-ps0(-1) > s1 then         << sorc dst underflow >>         06803000
      begin                                                             06804000
out'of'bounds:                                                          06805000
         qstat.ccf:=ccg;                                                06806000
         go exit;                                                       06807000
      end;                                                              06808000
   end;                                                                 06809000
   go do'mbtds;                                                         06810000
mbtds':                                                                 06811000
   tos:=0d;                            << save'firstw, save'lastw >>    06812000
   tos:=dest'loc;                      << dst, addr >>                  06813000
   tos:=tos&lsr(1);                    << dest'wp >>                    06814000
   tos:=sorc'addr&lsr(1);              << sorc'wp >>                    06815000
   push(s,z,dl,db,sbank);                                               06816000
   asmb(delb,cmp);                     << del db; only need dbbank >>   06817000
   if = then                           << sbank = dbbank? >>            06818000
   begin                                                                06819000
      asmb(zrox,xch);                  << xch z,dl >>                   06820000
      if tos <= x <= tos then          << at stack >>                   06821000
      begin                                                             06822000
         if tos < s1 then tos.(0:1):=1;<< db-minus >>                   06823000
      end else del;                    << clean up stack >>             06824000
   end else asmb(ddel,del);            << "            " >>             06825000
do'mbtds:                                                               06826000
   qstat'cce;                          << qstat.ccf:=cce >>             06827000
   x:=ilen;                                                             06828000
   tos:=(x+1)&lsr(1);                  << word count >>                 06829000
   if = then go exit;                  << no move >>                    06830000
   if sorc'addr then                                                    06831000
   begin                                                                06832000
      if dest'addr then                                                 06833000
      begin                                                             06834000
         @sorc'bp:=@sorc'bp-1;                                          06835000
         save'firstw:=sorc'wp;                                          06836000
         if lx then                    << x = len >>                    06837000
         begin     << sorc: byte   dest: byte   len: odd  >>            06838000
            asmb(stbx,ldxa);           << tos:=@sorc'wp >>              06839000
            tos:=dest'locw;            << dest'dst, @dest'wp >>         06840000
            tos:=1;                                                     06841000
            asmb(mfds);                << get 1st  dest word >>         06842000
            sorc'bp(1):=save'firstw;                                    06843000
            asmb(mtds);                                                 06844000
            sorc'bp:=save'firstb;      << restore 1st  sorc >>          06845000
exit:                                                                   06846000
            return;                                                     06847000
         end;                                                           06848000
         begin     << sorc: byte   dest: byte   len: even >>            06849000
            save'lastw:=sorc'wp(s0);   << s0 = (len+1)/2 >>             06850000
            tos:=@sorc'wp;                                              06851000
            tos:=dest'locw;            << dest'dst, @dest'wp >>         06852000
            tos:=1;                                                     06853000
            asmb(mfds);                << get 1st  dest word >>         06854000
            tos:=@sorc'wp(x);          << x = wlen >>                   06855000
            tos:=dest'dst;                                              06856000
            tos:=@dest'wp(x);          << "      " >>                   06857000
            tos:=1;                                                     06858000
            asmb(mfds);                << get last dest word >>         06859000
            sorc'bp(1):=save'firstw;                                    06860000
            sorc'bp(len):=save'lastb;                                   06861000
            x:=x+1;                    << len+1 >>                      06862000
            tos:=tos+1;                << move extra word >>            06863000
            asmb(mtds);                                                 06864000
            sorc'bp:=save'firstb;      << restore 1st  sorc >>          06865000
            sorc'bp(x):=tos;           << x:=len+1; tos=save'lastw >>   06866000
            return;                                                     06867000
         end;                                                           06868000
      end;                                                              06869000
      begin        << sorc: byte   dest: word   len: any  >>            06870000
         if lx then tos:=tos-1;       << move'len-1 (x = len) >>        06871000
         save'word:=sorc'wp;                                            06872000
         asmb(incb,decx);             << @sorc'wp+1; x:=len-1 >>        06873000
         asmb(mtds);                                                    06874000
         save'dst:=exchangedb(dest'dst);                                06875000
         move dest'bp(x):=dest'bp(x:=x-1),(not lx);                     06876000
         dest'bp:=tos;                << tos=save'word >>               06877000
         tos:=exchangedb(save'dst);                                     06878000
         return;                                                        06879000
      end;                                                              06880000
   end;                                                                 06881000
      if dest'addr then                                                 06882000
      begin                                                             06883000
         @dest'wp:=@dest'wp+1;                                          06884000
         tos:=tos-1;                   << move'len-1 >>                 06885000
         if lx then                    << x = len >>                    06886000
         begin     << sorc: word   dest: byte   len: odd  >>            06887000
            save'lastw:=sorc'wp(s0);   << s0 = (len+1)/2 >>             06888000
            asmb(mtds);                                                 06889000
            save'dst:=exchangedb(dest'dst);                             06890000
            tos:=dest'addr;                                             06891000
            tos:=s0+1;                 << dest'addr(1) >>               06892000
            x:=ilen;                                                    06893000
            move *:=*,(x:=x-1);        << dest:=dest(1),(len-1) >>      06894000
            dest'bp(x):=save'lastb;    << x = len-1 >>                  06895000
         end else                                                       06896000
         begin     << sorc: word   dest: byte   len: even >>            06897000
            save'firstw:=sorc'wp;                                       06898000
            asmb(incb,decx);           << @sorc'wp+1; x:=len-1 >>       06899000
            asmb(mtds);                                                 06900000
            save'dst:=exchangedb(dest'dst);                             06901000
            move dest'bp(x):=dest'bp(x:=x-1),(-x);                      06902000
            dest'bp:=save'firstb;                                       06903000
            del;                       << save'lastw >>                 06904000
            dest'bp(1):=tos;           << tos=save'firstw >>            06905000
         end;                                                           06906000
         tos:=exchangedb(save'dst);                                     06907000
         return;                                                        06908000
      end;                                                              06909000
         if lx then                    << x = len >>                    06910000
         begin     << sorc: word   dest: word   len: odd  >>            06911000
            save'lastw:=sorc'wp(s0-1); << s0 = (len+1)/2 >>             06912000
            tos:=@sorc'wp(x);          << x = wlen >>                   06913000
            tos:=dest'dst;                                              06914000
            tos:=@dest'wp(x);          << "      " >>                   06915000
            tos:=1;                                                     06916000
            asmb(mfds);                << get last dest word >>         06917000
            x:=ilen;                                                    06918000
            sorc'bp(x:=x-1):=save'lastb;<< insert last sorc >>          06919000
            asmb(mtds);                                                 06920000
            sorc'bp(x:=x+1):=tos;      << tos=save'lastw >>             06921000
            return;                                                     06922000
         end;                                                           06923000
         asmb(mtds);<< sorc: word   dest: word   len: even >>           06924000
end;   << mbtds >>                                                      06925000
procedure HelpMe;                                                       06926000
  option privileged,uncallable,internal;                                06927000
  begin                                                                 06928000
  help;  << need a call to allow help breakpoints >>                    06929000
  end;                                                                  06930000
                                                                        06931000
procedure badpcal;                                                      06932000
  option privileged,uncallable,internal;                                06933000
  begin                                                                 06934000
  << This procedure must be last >>                                     06935000
  << This procedure is called if a "PCAL 0" with tos = 0 is done. >>    06936000
  suddendeath(badport);                                                 06937000
  end;                                                                  06938000
                                                                        06939000
$control segment=seg'                                                   06940000
end.                                                                    06941000
