$SET X5=OFF                                                             00001000
$control map,code,uslinit,lines=120                                     00002000
$control main=mpeports,privileged,uncallable                            00003000
COMMENT   ---------------- Version History ------------------           00004000
  MPE IV:                                                               00005000
     A.00.00 - version in use up to 5-5-83                              00006000
     A.01.00 - PortEnable & PortDisable made type logical. 5-6-83       00007000
     A.01.01 - SoftIntPlabel added. 5-6-83                              00008000
     A.01.02 - SysGlobExt cell & AltDSegSize fixed.  5-9-83             00009000
     A.01.03 - same as B.01.04  5-12-83                                 00010000
     A.01.04 - same as B.01.05  5-25-83                                 00011000
     A.01.05 - same as B.01.06  6-7-83                                  00012000
  MPE V:                                                                00013000
     B.01.02 - first version given to CSY. 5-9-83                       00014000
     B.01.03 - changed some pcbx's back to pins. 5-10-83                00015000
     B.01.04 - FetchSeg, SegCompletor, IOWaitDisp fixes. 5-12-83        00016000
     B.01.05 - altered size of ports. added InitPortDST' and            00017000
               CreatePort' and CreatIOWaitPort'.  5-25-83               00018000
     B.01.06 - redid WaitforMsg and timers      6-7-83                  00019000
;  << end of comment >>                                                 00020000
begin                                                                   00021000
define asmb = assemble#;                                                00022000
integer x = x;                                                          00023000
integer pointer cst = 1,  << SPL generates LST/SST instructions >>      00024000
                dst = 2,                                                00025000
                pcb = 3;                                                00026000
                                                                        00027000
define abs = absolute#;                                                 00028000
                                                                        00029000
<< MPE data structures >>                                               00030000
equate QI = 5,  << Initial stack marker on ICS.  Same as ICS base. >>   00031000
       pcbb = 3,                                                        00032000
       cpcb = 4;  << low core addresses >>                              00033000
define to'xds = abs(cpcb) + 2#;  << offset to xds in pcb >>             00034000
$IF  X5=OFF                                                             00035000
define curpin  = (abs(cpcb) - abs(pcbb))/pcbsize#,                      00036000
       pcb'iqptr = 8#,  iqptr = (8:8)#,                                 00037000
       pcbsize = 16#,                                                   00038000
       pcb'xds = abs(x).(1:10)#;                                        00039000
$IF  X5=ON                                                              00040000
define curpin  = abs(cpcb)/pcbsize#,                                    00041000
       pcb'iqptr = 17#,                                                 00042000
       pcbsize = 21#,                                                   00043000
       pcb'xds = pcb(x).(2:14)#;                                        00044000
$IF                                                                     00045000
                                                                        00046000
integer pointer sysglobext = %377;                                      00047000
define max'pin = pcb(0)#;                                               00048000
equate sysdispawakemsg = %1050,  << MPE 4? >>                           00049000
       sysawakeschedmsg = %1052; << MPE 4? >>                           00050000
define disprunningflag = (0:1)#, << MPE 4? >>                           00051000
       pausedflag = (15:1)#;     << MPE 4? >>                           00052000
                                                                        00053000
$IF  X5=OFF                                                             00054000
define SysPort'pin = sysglobext(%102)#;  << sysglob entry >>            00055000
$IF  X5=ON                                                              00056000
define SysPort'pin = sysglobext(%120)#;                                 00057000
$IF                                                                     00058000
                                                                        00059000
equate MsgHarbTabDSTN = %71,  << system PortDST >>                      00060000
       MsgHarbPortLength = 16;  << sytem PortLength >>                  00061000
equate IOWait'PortId'DST = %72;  << system IOWAIT to PortId map table >>00062000
                                                                        00063000
$IF  X5=OFF                                                             00064000
equate aftsize = 4,   << for addressing the aft >>                      00065000
       to'pxaftsize = 5,                                                00066000
       to'ioqx = 3,                                                     00067000
$IF  X5=ON                                                              00068000
equate aftsize = 6,                                                     00069000
       to'pxaftsize = 6,                                                00070000
       to'ioqx = 5,                                                     00071000
$IF                                                                     00072000
       aft'base = 4,                                                    00073000
       softintpend = -2,  << aft(3) when softint enabled >>             00074000
       iowaitport'type = 9;                                             00075000
                                                                        00076000
define aft'type = aft.(0:4)#,   << AFT type, admin by filesys >>        00077000
       aft'subtype = aft.(4:4)#;  << AFT subtype, admin by Ports >>     00078000
<< DS-IPC has subtype 13 (base 10) allocated; see Brian >>              00079000
<< SNA-XPORT has subtype 10 allocated; see Perry >>                     00080000
<< IMF has subtype 5 allocated; see Chuck >>                            00081000
<< ***** end of MPE data structures ***** >>                            00082000
equate badportcall = 622,   << suddendeath numbers >>                   00083000
       wrongDST = 621,                                                  00084000
       badport = 620;                                                   00085000
                                                                        00086000
equate                                                                  00087000
       noinfo = 0,   << wait flags >>                                   00088000
       nowait = 0,   << awake's wait field for nowait >>                00089000
       msgwaitcode = 4;  << wait for msg waitfield code >>              00090000
                                                                        00091000
                                                                        00092000
define disable = asmb( sed 0 )#,                                        00093000
       enable  = asmb( sed 1 )#,                                        00094000
       pdisable = asmb( psdb )#,                                        00095000
       penable  = asmb( pseb )#;                                        00096000
                                                                        00097000
integer QM3 = Q -3,  << for addressing of the stack marker >>           00098000
        QM2 = Q -2,                                                     00099000
        QM1 = Q -1,                                                     00100000
        QM0 = Q -0;                                                     00101000
                                                                        00102000
integer Xreg = QM3, << for addr of the stack marker >>                  00103000
        deltaP = QM2,                                                   00104000
        OldStatus = QM1,                                                00105000
        deltaQ = QM0;                                                   00106000
                                                                        00107000
define cc = OldStatus.(6:2)#;                                           00108000
equate cce = 2,                                                         00109000
       ccg = 0,                                                         00110000
       ccl = 1;                                                         00111000
                                                                        00112000
define turn'traps'off = << disable arithmetic traps >>                  00113000
  begin                                                                 00114000
  push(status);                                                         00115000
  tos.(2:1) := false;                                                   00116000
  set(status);                                                          00117000
  end#;                                                                 00118000
                                                                        00119000
<< msg format equates >>                                                00120000
equate msg'link = 0,                                                    00121000
       msg'length = 1,                                                  00122000
       msg'data = 2;                                                    00123000
                                                                        00124000
<< Port DST structure >>                                                00125000
integer PortDSTnum = DB + 0;                                            00126000
integer PortDSTsize = DB + 1;                                           00127000
integer pointer UserRegionPointer = DB + 2;  << used by others!! >>     00128000
integer PortDSTMaxSubqueue = DB + 3;                                    00129000
integer PortDSTMaxMsgSize = DB + 4;                                     00130000
integer PortDSTMaxContextSize = DB + 5;                                 00131000
                                                                        00132000
integer pointer MsgPoolHead = DB + 6,                                   00133000
                MsgPoolTail = MsgPoolHead +1;                           00134000
integer PoolCnt = DB +8;                                                00135000
integer ProcHead = DB +9,                                               00136000
        ProcTail = DB +10;                                              00137000
integer TimeHead = DB +11;   << contains data of pointer type >>        00138000
integer TimeTRLX = DB +12;                                              00139000
equate PortDSTHeaderSize = 13,                                          00140000
       MsgHarbHeaderSize = PortDSTHeaderSize;                           00141000
                                                                        00142000
<< Port ControlBlock structure >>                                       00143000
define PortCB'flags   = PortCB#,                                        00144000
       PortCB'mask    = PortCB(1)#,                                     00145000
       PortCB'pin     = PortCB(2)#,                                     00146000
       PortCB'subtype = PortCB(4).(0:4)#,                               00147000
       PortCB'delete  = PortCB(4).(10:1)#,                              00148000
       PortCB'active  = PortCB(4).(11:1)#,                              00149000
       PortCB'enabled = PortCB(4).(12:1)#,                              00150000
       PortCB'traced = PortCB(4).(13:1)#,                               00151000
       PortCB'context = PortCB(3)#,                                     00152000
       SemaphoreCnt = IntPortCB(3)#,                                    00153000
       PortCB'type    = PortCB(4)#,                                     00154000
       pdisabled = (15:1)#,  << PortCB(4).(15:1) >>                     00155000
       DB'PortDST = (14:1)#, << PortCB(4).(14:1) >>                     00156000
                                                                        00157000
       PortCB'server'plabel = PortCB(5)#;                               00158000
                                                                        00159000
equate SubqueuesOffset = 3;   << double index >>                        00160000
                                                                        00161000
<< Port types >>                                                        00162000
equate normal'subtype = 0,                                              00163000
       Semaphore'subtype = 1,                                           00164000
       IOWait'subtype = 2;                                              00165000
                                                                        00166000
<< IOWait Ports use a reserved region of the context area >>            00167000
<<   for maintaining the AFT, SoftInt, and PortProc info. >>            00168000
define IOWait'count = Context#,                                         00169000
       IOWait'aftindex = Context(1)#,                                   00170000
       IOWait'portplabel = Context(2)#,                                 00171000
       IOWait'softint'plabel = Context(3)#,                             00172000
       IOWait'aftioqx = Context(4)#;                                    00173000
                                                                        00174000
equate IOWait'usercontext = 5;   << offset to user's part of context >> 00175000
                                                                        00176000
<< Signal Ports use a 3 word context area >>                            00177000
define homeport       = dblcontext(0)#,                                 00178000
       homesubqueue   = context(2)#;                                    00179000
                                                                        00180000
<< Timer message structure >>                                           00181000
equate abstime'index = 2;                                               00182000
define TimerCB'length    = TimerCB(1)#,                                 00183000
       TimerCB'reqid     = TimerCB(2)#,                                 00184000
       TimerCB'subqueue  = TimerCB(3)#,                                 00185000
       TimerCB'abstime = TimerCB'dbl(abstime'index)#,                   00186000
       TimerCB'replyport = TimerCB'dbl(3)#;                             00187000
equate TimerPoppedLen = 3;  << length of timer msg after it pops >>     00188000
equate TimerLength = 8;  << length of timer entry msg frames >>         00189000
                                                                        00190000
define std'decl = integer PortDST = PortId;                             00191000
                  logical pointer PortCB = PortId +1;                   00192000
                  double pointer PortCB'dbl = PortCB;                   00193000
                  double array AbsAddresses(*) = Q;  << no space >>     00194000
                  double AbsPortDB = AbsAddresses;                      00195000
                  integer AbsDB = AbsPortDB +1;                         00196000
                  double CallersDB = AbsAddresses + 2;                  00197000
                  double AbsMessage = AbsAddresses + 4#,                00198000
      std'decl2 = double dbl'ptrs;                                      00199000
                  integer pointer qhead = dbl'ptrs,                     00200000
                                  qtail = dbl'ptrs +1#;                 00201000
$page                                                                   00202000
                                                                        00203000
define exchangedb'to'PortDST =                                          00204000
  begin                                                                 00205000
  turn'traps'off;                                                       00206000
  tos := %344;  << DST 71 >>  << +*+ >>                                 00207000
  tos := abs(abs(2))&lsl(2);  << +*+ >>                                 00208000
  x := PortDST&LSL(2);                                                  00209000
  if not (tos <= x <= tos) then suddendeath(wrongDST);  << +*+ >>       00210000
  disable;                                                              00211000
  tos := dst(x);                                                        00212000
  if < then                                                             00213000
    do begin  << absent! >>                                             00214000
      del;                                                              00215000
$IF  X5=OFF                                                             00216000
      queueonsegment(PortDST.(2:14));                                   00217000
$IF  X5=ON                                                              00218000
      queueonsegment(double(PortDST.(2:14)));                           00219000
$IF                                                                     00220000
      tos := dst(x);                                                    00221000
    end until > ;                                                       00222000
  tos.(2:1) := true;  << set ref. bit >>                                00223000
  dst(x) := tos;                                                        00224000
  pdisable;                                                             00225000
  enable;                                                               00226000
                                                                        00227000
  tos := dst(x:=x+2);  << bank >>                                       00228000
  tos := dst(x:=x+1);  << addr >>                                       00229000
  asmb( ddup );                                                         00230000
  asmb( xchd );                                                         00231000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       00232000
  end#;  << Note that AbsPortDB and CallersDB is set/allocated here >>  00233000
                                                                        00234000
define exchangedb'back =                                                00235000
  begin                                                                 00236000
  asmb( xchd );                                                         00237000
  asmb( subs 4);  << Note: both AbsPortDB and CallersDB are popped >>   00238000
  penable;                                                              00239000
  end#;  << exchangedb'back >>                                          00240000
                                                                        00241000
<< CallersDB must be previously initialized >>                          00242000
define CalcAbsQ =  << push absolute bank and address onto tos >>        00243000
  begin                                                                 00244000
  push(Q,SBank);                                                        00245000
  tos := AbsDB;                                                         00246000
  asmb( cab,ladd );                                                     00247000
  end#;                                                                 00248000
                                                                        00249000
<< a move absolute requries five words on tos >>                        00250000
define mabs5 = << perform the move, and pop all parameters >>           00251000
  asmb( mabs 5 )#;                                                      00252000
                                                                        00253000
<< Check if executing on the ICS.  Done by checking if the >>           00254000
<< Q register is between the ICS limits of QI and ZI. >>                00255000
<< The tos is true if on the ICS, false otherwise. >>                   00256000
<< Also, if the pdisable count is greater than one, treat as >>         00257000
<< if on the ICS.  This assumes that the caller has one pdisable >>     00258000
<< in effect. >>                                                        00259000
                                                                        00260000
<< Interrupts must be disabled before this define is used >>            00261000
define on'ics =                                                         00262000
  begin                                                                 00263000
  if abs(abs(QI)-18) > 1 then tos := -1  << check pdisable count >>     00264000
  else                                                                  00265000
    begin                                                               00266000
    push(q,db,sbank);                                                   00267000
    asmb( cab,del );   << delete DB Bank >>                             00268000
    if tos <> 0 then asmb( ddel,zero )  << SBank <> 0 >>                00269000
    else                                                                00270000
      begin                                                             00271000
      asmb( ladd,stax );  << abs Q into X reg for CPRB >>               00272000
      tos := 5D;  << abs addr of QI,ZI >>                               00273000
      asmb( ldea );                                                     00274000
      asmb( dxch,ddel );  << delete 5D >>                               00275000
      if tos <= x <= tos                                                00276000
        then tos := -1                                                  00277000
        else tos := 0;                                                  00278000
      end;                                                              00279000
    end;                                                                00280000
  end#;                                                                 00281000
$page                                                                   00282000
<< Interrupts must be disabled before this define is used >>            00283000
define reset'message'bit =                                              00284000
  begin  << turn off the more messages flag >>                          00285000
  tos := PortCB'flags;                                                  00286000
  x := Subqueue;                                                        00287000
  asmb( trbc 0,x );                                                     00288000
  PortCB'flags := tos;                                                  00289000
  end#;  << reset'message'bit >>                                        00290000
                                                                        00291000
<< Interrupts must be disabled before this define is used >>            00292000
define set'message'bit =                                                00293000
  begin  << turn on the more messages flag >>                           00294000
  tos := PortCB'flags;                                                  00295000
  x := Subqueue;                                                        00296000
  asmb( tsbc 0,x );                                                     00297000
  PortCB'flags := tos;                                                  00298000
  end#;  << set'message'bit >>                                          00299000
                                                                        00300000
<< Interrupts must be disabled before this define is used >>            00301000
define dequeue'message =                                                00302000
  begin                                                                 00303000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   00304000
  @msg := @qhead;                                                       00305000
  @qhead := qhead;                                                      00306000
  if <> then PortCB'dbl(x) := dbl'ptrs                                  00307000
  else                                                                  00308000
    begin  << exausted a Subqueue >>                                    00309000
    PortCB'dbl(x) := 0D;                                                00310000
    reset'message'bit;  << turn off the more messages bit >>            00311000
    end;                                                                00312000
  end#;  << dequeue'message >>                                          00313000
                                                                        00314000
<< Interrupts must be disabled before this define is used >>            00315000
define dequeue'hipri'message =                                          00316000
  begin                                                                 00317000
  tos := PortCB'dbl;  << load both flags and mask >>                    00318000
  asmb( and );                                                          00319000
  if = then                                                             00320000
    begin   << no enabled subqueues with messages >>                    00321000
    @msg := tos;  << @msg := 0  because of = test above >>              00322000
    end                                                                 00323000
  else                                                                  00324000
    begin  << dequeue the highest priority Msg >>                       00325000
    asmb( scan );                                                       00326000
    asmb( del );                                                        00327000
    Subqueue := x;                                                      00328000
    dequeue'message;   << dequeue the message from the subqueue >>      00329000
    msg := Subqueue;                                                    00330000
    end;                                                                00331000
  end#;  << dequeue'hipri'message >>                                    00332000
$page                                                                   00333000
<< Note that WaitForMsg preserves the interrupt disable state >>        00334000
<< below, and re-disabling interrupts is not necessary. >>              00335000
define allocate'message'frame =                                         00336000
  begin                                                                 00337000
  disable;                                                              00338000
  PoolCnt := PoolCnt -1;                                                00339000
  if < then                                                             00340000
    begin                                                               00341000
    on'ics;  << set tos if on ics, or pdisable > 1 >>                   00342000
    if not tos then                                                     00343000
      do begin  << Into Secondary pool and process is impedable >>      00344000
        PoolCnt := PoolCnt +1;                                          00345000
        WaitForMsg;   <<+*+ what about abs db's? >>                     00346000
        PoolCnt := PoolCnt -1;                                          00347000
      end until >=;                                                     00348000
    end;                                                                00349000
  @msg := @MsgPoolHead;     << get a message from the free pool >>      00350000
  if = then enable  << Pool empty! >>                                   00351000
  else                                                                  00352000
    begin                                                               00353000
    << msg available, delink it from free pool >>                       00354000
    @MsgPoolHead := MsgPoolHead;                                        00355000
    if = then                                                           00356000
      @MsgPoolTail := 0;  << Pool now empty >>                          00357000
    enable;                                                             00358000
    end;                                                                00359000
  end#;                                                                 00360000
                                                                        00361000
define release'message'frame =                                          00362000
  begin                                                                 00363000
  msg := 0;                                                             00364000
  disable;                                                              00365000
  if @MsgPoolHead <> 0 then                                             00366000
    begin  << Pool not empty, queue to tail >>                          00367000
    @MsgPoolTail := MsgPoolTail := @msg;                                00368000
    end                                                                 00369000
  else                                                                  00370000
    begin  << Pool was empty, should never happen >>                    00371000
    @MsgPoolHead := @MsgPoolTail := @msg;                               00372000
    end;                                                                00373000
  PoolCnt := PoolCnt +1;                                                00374000
  if > and ProcHead <> 0 then AwakeForMsg;                              00375000
  enable;                                                               00376000
  end#;  << release'message'frame >>                                    00377000
$page "external declarations"                                           00378000
procedure help;                                                         00379000
  option external;                                                      00380000
                                                                        00381000
procedure suddendeath(type);                                            00382000
  value type;                                                           00383000
  integer type;                                                         00384000
  option external;                                                      00385000
                                                                        00386000
procedure queueonsegment(segid);                                        00387000
  value segid;                                                          00388000
$IF X5=OFF                                                              00389000
  integer segid;                                                        00390000
$IF X5=ON                                                               00391000
  double segid;                                                         00392000
$IF                                                                     00393000
  option external;                                                      00394000
                                                                        00395000
integer procedure exchangedb(dstn);                                     00396000
  value dstn;                                                           00397000
  integer dstn;                                                         00398000
  option external;                                                      00399000
                                                                        00400000
procedure clearwws;                                                     00401000
  option external;                                                      00402000
                                                                        00403000
procedure awake(pcbpt,wakecode,waitflags);                              00404000
  value pcbpt,wakecode,waitflags;                                       00405000
  integer pcbpt;                                                        00406000
  logical wakecode,waitflags;                                           00407000
  option external;                                                      00408000
                                                                        00409000
procedure wait(eventmask,specialinfo);                                  00410000
  value eventmask,specialinfo;                                          00411000
  logical eventmask,specialinfo;                                        00412000
  option external;                                                      00413000
                                                                        00414000
procedure causesoftint(pin,type,subtype,plabel,msglen,flags);           00415000
  value pin,type,subtype,plabel,msglen,flags;                           00416000
  integer pin,type,subtype,plabel,msglen;                               00417000
  logical flags;                                                        00418000
  option external;                                                      00419000
                                                                        00420000
procedure bumpqpri(holderpin,headpin);                                  00421000
  value holderpin,headpin;                                              00422000
  integer holderpin,headpin;                                            00423000
  option external;                                                      00424000
                                                                        00425000
procedure impede(pinx);                                                 00426000
  value pinx;                                                           00427000
  integer pinx;                                                         00428000
  option external;                                                      00429000
                                                                        00430000
procedure unimpede(pinx);                                               00431000
  value pinx;                                                           00432000
  integer pinx;                                                         00433000
  option external;                                                      00434000
                                                                        00435000
integer procedure getdataseg(memsize,vdsize);                           00436000
  value memsize,vdsize;                                                 00437000
  integer memsize,vdsize;                                               00438000
  option external;                                                      00439000
                                                                        00440000
<< Same as "getdataseg", except the segment is initalized to zeros >>   00441000
integer procedure getdatasegc(memsize,vdsize);                          00442000
  value memsize,vdsize;                                                 00443000
  integer memsize,vdsize;                                               00444000
  option external;                                                      00445000
                                                                        00446000
integer procedure altdsegsize(dstindex,size);                           00447000
  value dstindex,size;                                                  00448000
  integer dstindex,size;                                                00449000
  option external;                                                      00450000
                                                                        00451000
procedure reldataseg(dstindex);                                         00452000
  value dstindex;                                                       00453000
  integer dstindex;                                                     00454000
  option external;                                                      00455000
                                                                        00456000
integer procedure Obtain(Res,AltRes);                                   00457000
  value AltRes;                                                         00458000
  integer Res,AltRes;                                                   00459000
  option external;                                                      00460000
                                                                        00461000
procedure Release(Res,AltRes,WakeUp);                                   00462000
  value AltRes,WakeUp;                                                  00463000
  logical WakeUp;                                                       00464000
  integer Res,AltRes;                                                   00465000
  option external;                                                      00466000
                                                                        00467000
integer procedure timereq(code,req,time);                               00468000
  value code,req,time;                                                  00469000
  integer code,req;                                                     00470000
  double time;                                                          00471000
  option external;                                                      00472000
                                                                        00473000
procedure aborttimereq(trlx);                                           00474000
  value trlx;                                                           00475000
  integer trlx;                                                         00476000
  option external;                                                      00477000
                                                                        00478000
double procedure timer;                                                 00479000
  option external;                                                      00480000
                                                                        00481000
                                                                        00482000
procedure iofreeze'(segident);                                          00483000
  value segident;                                                       00484000
$IF  X5=OFF                                                             00485000
  logical segident;                                                     00486000
$IF  X5=ON                                                              00487000
  double segident;                                                      00488000
$IF                                                                     00489000
  option external;                                                      00490000
                                                                        00491000
procedure iounfreeze'(segident);                                        00492000
  value segident;                                                       00493000
$IF  X5=OFF                                                             00494000
  logical segident;                                                     00495000
$IF  X5=ON                                                              00496000
  double segident;                                                      00497000
$IF                                                                     00498000
  option external;  << alternate entry point into iofreeze' >>          00499000
integer procedure DST'Size(DSTno);                                      00500000
  value                    DSTno;                                       00501000
  integer                  DSTno;                                       00502000
  option external;                                                      00503000
                                                                        00504000
integer procedure Wheres'DB;                                            00505000
  option external;                                                      00506000
                                                                        00507000
COMMENT                                                                 00508000
                                                                        00509000
IOFREEZE' IS CALLED FROM I/O SYSTEM MONITORS TO FREEZE' A               00510000
SEGMENT IN MEMORY SO THAT INSTRUCTION FETCH AND DATA                    00511000
TRANSFER BY DMA I/O SYSTEM DEVICES MAY TAKE PLACE.  IF                  00512000
THE REQUIRED SEGMENT IS PRESENT, THE SEGMENT GETS IO FROZEN             00513000
IF IT IS ABSENT, STATUS THROUGH THE CONDITION CODE IS RETURNED          00514000
AND NOTHING IS DONE.  THE MONITOR MUST MAKE A SPECIAL                   00515000
REQUEST FOR THE SEGMENT TO THE SCHEDULER, SINCE BLOCKING                00516000
THE MONITOR ON THE ICS IN IOFREEZE' WOULDN'T WORK.                      00517000
                                                                        00518000
;                                                                       00519000
                                                                        00520000
procedure fetchioseg(segid,ldev,ioreqsysbaseinx,flags);                 00521000
  value segid,ldev,ioreqsysbaseinx,flags;                               00522000
$IF  X5=OFF                                                             00523000
  logical segid,ldev,ioreqsysbaseinx,flags;                             00524000
$IF  X5=ON                                                              00525000
double  segid;                                                          00526000
logical ldev, ioreqsysbaseinx, flags;                                   00527000
$IF                                                                     00528000
  option external;                                                      00529000
                                                                        00530000
COMMENT                                                                 00531000
                                                                        00532000
FETCHIOSEG IS USED BY I/O SYSTEM MONITORS TO REQUEST SEGMENTS ON        00533000
BEHALF OF DEVICES.  THIS INTERFACE ALLOWS THE CALLER TO REQUEST         00534000
A DRIVER OR BUFFER DATA SEGMENT IN AN UNBLOCKED MANNER.  WHEN THE       00535000
SEGMENT ARRIVES, IT IS IOFROZEN IF THIS HAD BEEN REQUESTED, AND         00536000
AWAKEIO IS CALLED ON THE APPROPRIATE DEVICE. ALSO, THE DATA FROZEN      00537000
BIT IN THE SPECIFIED I/O REQUEST FLAGS WORD IS SET FOR DATA SEGMENT     00538000
REQUESTS, AND THE DRIVER FROZEN BIT IN THE ILT IS SET FOR DRIVER        00539000
FETCH REQUESTS.                                                         00540000
                                                                        00541000
PARAMETER SPECIFICATION :                                               00542000
                                                                        00543000
   SEGID : .(0:2) = SEG TYPE FIELD                                      00544000
                                                                        00545000
                  = 0 ==> DATA SEG ==> .(2:14) = DST NUMBER             00546000
                  = 1 ==> SL SEG   ==> .(2:14) = SL NUMBER              00547000
                  = 2 ==> PROG SEG ==> .(1:7) = CSTXBLK INDEX,          00548000
                                       .(8:8) = LOG SEG #               00549000
                                                                        00550000
   LDEV : LOGICAL DEVICE NUMBER OF DEVICE REQUIRING SEGMENT             00551000
                                                                        00552000
   IOREQSYSBASEINX : SYSBASE RELATIVE INDEX OF BASE OF I/O REQUEST      00553000
                     ELEMENT ASSOCIATED WITH THE SEGMENT FETCH REQUEST  00554000
                     (ONLY REQUIRED FOR DATA SEGMENT FETCH REQUESTS)    00555000
                                                                        00556000
   FLAGS : .(0:1) = 1 ==> IOFREEZE SEGMENT WHEN IT ARRIVES              00557000
                                                                        00558000
CONDITION CODE RETURN SPECIFICATION :                                   00559000
                                                                        00560000
   RETURN CC = CCE ==> SEGMENT IS PRESENT, AND HAS BEEN I/O FROZEN      00561000
                       IF SO REQUESTED (BUT DATA FROZEN, DRIVER FROZEN  00562000
                       BITS NOT SET, AWAKEIO NOT CALLED)                00563000
             = CCG ==> SEGMENT NOT AROUND, AND REQUEST FOR SEGMENT      00564000
                       HAS BEEN ISSUED.                                 00565000
;                                                                       00566000
$page "forward declarations"                                            00567000
<<$SPLINTR$  Used to automate the building of the SPLINTR file >>       00568000
                                                                        00569000
double procedure FindProcessPort(Pin);                                  00570000
  value Pin;                                                            00571000
  integer Pin;                                                          00572000
  option forward;                                                       00573000
                                                                        00574000
procedure Send'DB(PortId,Subqueue,Message);                             00575000
  value PortId,Subqueue,Message;                                        00576000
  double PortId;                                                        00577000
  integer Subqueue;                                                     00578000
  integer pointer Message;                                              00579000
  option forward;                                                       00580000
                                                                        00581000
procedure Send'Q(PortId,Subqueue,Message);                              00582000
  value PortId,Subqueue,Message;                                        00583000
  double PortId;                                                        00584000
  integer Subqueue;                                                     00585000
  integer pointer Message;  <<;';>>                                     00586000
<<integer Message;>> << Message is the caller's Qreg relative           00587000
                        address. >>                                     00588000
  option forward;                                                       00589000
                                                                        00590000
procedure Send'S(PortId,Subqueue,Message);                              00591000
  value PortId,Subqueue,Message;                                        00592000
  double PortId;                                                        00593000
  integer Subqueue;                                                     00594000
  integer pointer Message;  <<;';>>                                     00595000
<<integer Message;>> << Message refers to the size of the               00596000
                          array allocated on tos. >>                    00597000
  option forward;                                                       00598000
                                                                        00599000
procedure Send'Ref(PortId,Subqueue,Message);                            00600000
  value PortId,Subqueue,Message;                                        00601000
  double PortId;                                                        00602000
  integer Subqueue;                                                     00603000
  integer pointer Message;                                              00604000
  option forward;                                                       00605000
                                                                        00606000
procedure Receive'DB(PortId,Message,EnableMask);                        00607000
  value PortId,Message,EnableMask;                                      00608000
  double PortId;                                                        00609000
  integer pointer Message;                                              00610000
  logical EnableMask;                                                   00611000
  option forward;                                                       00612000
                                                                        00613000
procedure Receive'Q(PortId,Message,EnableMask);                         00614000
  value PortId,Message,EnableMask;                                      00615000
  double PortId;                                                        00616000
  integer pointer Message;  <<;';>>                                     00617000
<<integer Message;>> << Message is the caller's Qreg relative           00618000
                        address. >>                                     00619000
  logical EnableMask;                                                   00620000
  option forward;                                                       00621000
                                                                        00622000
procedure Receive'S(PortId,Message,EnableMask);                         00623000
  value PortId,Message,EnableMask;                                      00624000
  double PortId;                                                        00625000
  integer pointer Message;  <<;';>>                                     00626000
<<integer Message;>> << Message refers to the size of the               00627000
                          array allocated on tos. >>                    00628000
  logical EnableMask;                                                   00629000
  option forward;                                                       00630000
                                                                        00631000
integer procedure Receive'Ref(PortId,Dummy,EnableMask);                 00632000
  value PortId,Dummy,EnableMask;                                        00633000
  double PortId;                                                        00634000
  integer Dummy;                                                        00635000
  logical EnableMask;                                                   00636000
  option forward;                                                       00637000
                                                                        00638000
procedure ReceiveWait'DB(PortId,Message,EnableMask);                    00639000
  value PortId,Message,EnableMask;                                      00640000
  double PortId;                                                        00641000
  integer pointer Message;                                              00642000
  logical EnableMask;                                                   00643000
  option forward;                                                       00644000
                                                                        00645000
procedure ReceiveWait'Q(PortId,Message,EnableMask);                     00646000
  value PortId,Message,EnableMask;                                      00647000
  double PortId;                                                        00648000
  integer pointer Message;  <<;';>>                                     00649000
<<integer Message;>> << Message is the caller's Qreg relative           00650000
                        address. >>                                     00651000
  logical EnableMask;                                                   00652000
  option forward;                                                       00653000
                                                                        00654000
procedure ReceiveWait'S(PortId,Message,EnableMask);                     00655000
  value PortId,Message,EnableMask;                                      00656000
  double PortId;                                                        00657000
  integer pointer Message;  <<;';>>                                     00658000
<<integer Message;>> << Message refers to the size of the               00659000
                          array allocated on tos. >>                    00660000
  logical EnableMask;                                                   00661000
  option forward;                                                       00662000
                                                                        00663000
procedure Replace'DB(PortId,Subqueue,Message);                          00664000
  value PortId,Subqueue,Message;                                        00665000
  double PortId;                                                        00666000
  integer Subqueue;                                                     00667000
  integer pointer Message;                                              00668000
  option forward;                                                       00669000
                                                                        00670000
procedure Replace'Q(PortId,Subqueue,Message);                           00671000
  value PortId,Subqueue,Message;                                        00672000
  double PortId;                                                        00673000
  integer Subqueue;                                                     00674000
  integer pointer Message;  <<;';>>                                     00675000
<<integer Message;>> << Message is the caller's Qreg relative           00676000
                        address. >>                                     00677000
  option forward;                                                       00678000
                                                                        00679000
procedure Replace'S(PortId,Subqueue,Message);                           00680000
  value PortId,Subqueue,Message;                                        00681000
  double PortId;                                                        00682000
  integer Subqueue;                                                     00683000
  integer pointer Message;  <<;';>>                                     00684000
<<integer Message;>> << Message refers to the size of the               00685000
                          array allocated on tos. >>                    00686000
  option forward;                                                       00687000
                                                                        00688000
procedure Replace'Ref(PortId,Subqueue,Message);                         00689000
  value PortId,Subqueue,Message;                                        00690000
  double PortId;                                                        00691000
  integer Subqueue;                                                     00692000
  integer pointer Message;                                              00693000
  option forward;                                                       00694000
                                                                        00695000
procedure Discard'Ref(PortId,Message);                                  00696000
  value PortId,Message;                                                 00697000
  double PortId;                                                        00698000
  integer pointer Message;                                              00699000
  option forward;                                                       00700000
                                                                        00701000
integer procedure GetMessage'Ref(PortId);                               00702000
  value PortId;                                                         00703000
  double PortId;                                                        00704000
  option forward;                                                       00705000
                                                                        00706000
procedure PortMaskDisable(PortId,DisableMask);                          00707000
  value PortId,DisableMask;                                             00708000
  double PortId;                                                        00709000
  logical DisableMask;                                                  00710000
  option forward;                                                       00711000
                                                                        00712000
procedure PortMaskEnable(PortId,EnableMask);                            00713000
  value PortId,EnableMask;                                              00714000
  double PortId;                                                        00715000
  logical EnableMask;                                                   00716000
  option forward;                                                       00717000
                                                                        00718000
logical procedure PortDisable(PortId);                                  00719000
  value PortId;                                                         00720000
  double PortId;                                                        00721000
  option forward;                                                       00722000
                                                                        00723000
logical procedure PortEnable(PortId);                                   00724000
  value PortId;                                                         00725000
  double PortId;                                                        00726000
  option forward;                                                       00727000
                                                                        00728000
integer procedure NewPortStatus(PortId,Type);                           00729000
  value PortId,Type;                                                    00730000
  double PortId;                                                        00731000
  integer Type;                                                         00732000
  option forward;                                                       00733000
                                                                        00734000
double procedure CreatePort(ClassName,PortDST,NewFrames);               00735000
  value PortDST,NewFrames;                                              00736000
  byte array ClassName;                                                 00737000
  integer PortDST,NewFrames;                                            00738000
  option forward;                                                       00739000
                                                                        00740000
procedure CreatePort'(PortDST, Type, Plabel, NumSubqueues, ContextSize, 00741000
                      PortId,  Result);                                 00742000
  value               PortDST, Type, Plabel, NumSubqueues, ContextSize; 00743000
  integer     Result, PortDST, Type, Plabel, NumSubqueues, ContextSize; 00744000
  double              PortId;                                           00745000
  option forward;                                                       00746000
procedure TerminatePort(PortId);                                        00747000
  value PortId;                                                         00748000
  double PortId;                                                        00749000
  option forward;                                                       00750000
                                                                        00751000
procedure DeletePort(PortId);                                           00752000
  value PortId;                                                         00753000
  double PortId;                                                        00754000
  option forward;                                                       00755000
                                                                        00756000
procedure AddPortClassName(ClassName,Plabel,Type,SubType,               00757000
                                ContextSize,MsgSize,NumSubqueues);      00758000
  value Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;           00759000
  byte array ClassName;                                                 00760000
  integer Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;         00761000
  option forward;                                                       00762000
                                                                        00763000
procedure DeletePortClassName(ClassName);                               00764000
  byte array ClassName;                                                 00765000
  option forward;                                                       00766000
                                                                        00767000
integer procedure InitPortDST(PortDST,MaxSubqueues,                     00768000
                                NumMessages,MaxMsgSize,                 00769000
                                MaxContextSize,                         00770000
                                UserReservedRegionSize);                00771000
  value   PortDST,MaxSubqueues,                                         00772000
            NumMessages,MaxMsgSize,                                     00773000
            MaxContextSize,                                             00774000
            UserReservedRegionSize;                                     00775000
  integer PortDST,MaxSubqueues,                                         00776000
            NumMessages,MaxMsgSize,                                     00777000
            MaxContextSize,                                             00778000
            UserReservedRegionSize;                                     00779000
  option forward;                                                       00780000
                                                                        00781000
procedure InitPortDST'(PrimaryPool, SecondaryPool, MaxMsgSize,          00782000
                       MaxPorts, MaxSubqueues, MaxContextSize,          00783000
                       UserRegSize, UserRegOffset, PortDST);            00784000
                                                                        00785000
  value                PrimaryPool, SecondaryPool, MaxMsgSize,          00786000
                       MaxPorts, MaxSubqueues, MaxContextSize,          00787000
                       UserRegSize;                                     00788000
                                                                        00789000
  integer              PrimaryPool, SecondaryPool, MaxMsgSize,          00790000
                       MaxPorts, MaxSubqueues, MaxContextSize,          00791000
                       UserRegSize, PortDST;                            00792000
integer pointer UserRegOffset;    option forward;                       00793000
procedure UpSemaphore(SemaphoreId);                                     00794000
  value SemaphoreId;                                                    00795000
  double SemaphoreId;                                                   00796000
  option forward;                                                       00797000
                                                                        00798000
procedure DownSemaphore'DB(SemaphoreId,Subqueue,Message);               00799000
  value SemaphoreId,Subqueue,Message;                                   00800000
  double SemaphoreId;                                                   00801000
  integer Subqueue;                                                     00802000
  integer pointer Message;                                              00803000
  option forward;                                                       00804000
                                                                        00805000
procedure DownSemaphore'Q(SemaphoreId,Subqueue,Message);                00806000
  value SemaphoreId,Subqueue,Message;                                   00807000
  double SemaphoreId;                                                   00808000
  integer Subqueue;                                                     00809000
  integer pointer Message;  <<;';>>                                     00810000
<<integer Message;>> << Message is the caller's Qreg relative           00811000
                        address. >>                                     00812000
  option forward;                                                       00813000
                                                                        00814000
procedure DownSemaphore'S(SemaphoreId,Subqueue,Message);                00815000
  value SemaphoreId,Subqueue,Message;                                   00816000
  double SemaphoreId;                                                   00817000
  integer Subqueue;                                                     00818000
  integer pointer Message;  <<;';>>                                     00819000
<<integer Message;>> << Message refers to the size of the               00820000
                          array allocated on tos. >>                    00821000
  option forward;                                                       00822000
                                                                        00823000
procedure DownSemaphore'Ref(SemaphoreId,Subqueue,Message);              00824000
  value SemaphoreId,Subqueue,Message;                                   00825000
  double SemaphoreId;                                                   00826000
  integer Subqueue;                                                     00827000
  integer pointer Message;                                              00828000
  option forward;                                                       00829000
                                                                        00830000
procedure Create'Semaphore'Port(PortDST, InitCount,                     00831000
                                PortId,  Result);                       00832000
  value                         PortDST, InitCount;                     00833000
  integer                       PortDST, InitCount, Result;             00834000
  double                        PortId;                                 00835000
  option forward;                                                       00836000
                                                                        00837000
procedure FetchSeg(SegId,ReqType,ReplyPort,                             00838000
                     ReplySubqueue);                                    00839000
  value SegId,ReqType,ReplyPort,ReplySubqueue;                          00840000
  logical SegId,ReqType;                                                00841000
  double ReplyPort;                                                     00842000
  integer ReplySubqueue;                                                00843000
  option forward;                                                       00844000
                                                                        00845000
procedure ReleaseSeg(SegId,ReqType);                                    00846000
  value SegId,ReqType;                                                  00847000
  logical SegId,ReqType;                                                00848000
  option forward;                                                       00849000
                                                                        00850000
double procedure StartTimer(DeltaTime,ReplyPort,ReplySubqueue,          00851000
                              ReqId);                                   00852000
  value DeltaTime,ReplyPort,ReplySubqueue,ReqId;                        00853000
  double DeltaTime,ReplyPort;                                           00854000
  integer ReplySubqueue,ReqId;                                          00855000
  option forward;                                                       00856000
                                                                        00857000
procedure AbortTimer(TimerId);                                          00858000
  value TimerId;                                                        00859000
  double TimerId;                                                       00860000
  option forward;                                                       00861000
                                                                        00862000
procedure Create'Signal'Port( PortDST, DestPortId,                      00863000
                              DestSubqueue, PortId, Result);            00864000
  value    PortDST, DestPortId, DestSubqueue;                           00865000
  integer  PortDST, DestSubqueue, Result;                               00866000
  double   DestPortId, PortId;                                          00867000
                                                                        00868000
  option forward;                                                       00869000
                                                                        00870000
double procedure CreateIOWaitPort(ClassName,PortDST,NewFrames);         00871000
  value ClassName,PortDST,NewFrames;                                    00872000
  byte pointer ClassName;                                               00873000
  integer PortDST,NewFrames;                                            00874000
  option forward;                                                       00875000
                                                                        00876000
procedure Create'IOWaitPort(PortDST, Plabel, NumSubques, ContextSize,   00877000
                            PortId,  Result);                           00878000
  value                     PortDST, Plabel, NumSubques, ContextSize;   00879000
  integer          Result,  PortDST, Plabel, NumSubques, ContextSize;   00880000
  double                    PortId;                                     00881000
  option forward;                                                       00882000
                                                                        00883000
integer procedure ChangeIOWaitPort(PortId,AFTindex,Pin,Plabel);         00884000
  value PortId,AFTindex,Pin,Plabel;                                     00885000
  double PortId;                                                        00886000
  integer AFTindex,Pin,Plabel;                                          00887000
  option forward;                                                       00888000
                                                                        00889000
integer procedure IncrementIOCount(PortId);                             00890000
  value PortId;                                                         00891000
  double PortId;                                                        00892000
  option forward;                                                       00893000
                                                                        00894000
integer procedure CheckIOCount(PortId);                                 00895000
  value PortId;                                                         00896000
  double PortId;                                                        00897000
  option forward;                                                       00898000
                                                                        00899000
procedure DictAdd(Name,Data,Result);                                    00900000
  integer array Name,Data;                                              00901000
  integer Result;                                                       00902000
  option forward;                                                       00903000
                                                                        00904000
procedure DictDelete(Name,Dummy,Result);                                00905000
  integer array Name,Dummy;                                             00906000
  integer Result;                                                       00907000
  option forward;                                                       00908000
                                                                        00909000
procedure DictFind(Name,Data,Result);                                   00910000
  integer array Name,Data;                                              00911000
  integer Result;                                                       00912000
  option forward;                                                       00913000
                                                                        00914000
procedure DictUpdate(Name,Data,Result);                                 00915000
  integer array Name,Data;                                              00916000
  integer Result;                                                       00917000
  option forward;                                                       00918000
                                                                        00919000
procedure DictSend(Name,Data,Result);                                   00920000
  integer array Name,Data;                                              00921000
  integer Result;                                                       00922000
  option forward;                                                       00923000
                                                                        00924000
<<$SPLINTR$>>                                                           00925000
$page "forward declarations - not in SPLINTR file"                      00926000
<< forward decl's that are NOT to be included in the SPLINTR file >>    00927000
                                                                        00928000
procedure WaitForMsg;                                                   00929000
  option forward;                                                       00930000
                                                                        00931000
procedure AwakeForMsg;                                                  00932000
  option forward;                                                       00933000
                                                                        00934000
procedure PortDispatcher(PortId);                                       00935000
  value PortId;                                                         00936000
  double PortId;                                                        00937000
  option forward;                                                       00938000
                                                                        00939000
procedure SysPortServer;                                                00940000
  option forward;  << NOT internal, but NOT in SPLINTR >>               00941000
                                                                        00942000
procedure ReceiveWait'server(PortId,Context,Message);                   00943000
  value PortId,Context,Message;                                         00944000
  double PortId;                                                        00945000
  integer pointer Context,Message;                                      00946000
  option forward;  << NOT internal, but NOT in SPLINTR >>               00947000
                                                                        00948000
                                                                        00949000
procedure GenerateDictname(ClassName,DictName);                         00950000
  byte array ClassName;                                                 00951000
  array DictName;                                                       00952000
  option forward;                                                       00953000
                                                                        00954000
procedure PortSeg'completor(msg'id);                                    00955000
  value msg'id;                                                         00956000
  integer msg'id;                                                       00957000
  option forward;                                                       00958000
                                                                        00959000
procedure PortTimeOut(TimerDST);                                        00960000
  value TimerDST;                                                       00961000
  integer TimerDST;                                                     00962000
  option forward;                                                       00963000
                                                                        00964000
procedure SignalPort'server(PortId,Context,Message);                    00965000
  value PortId,Context,Message;                                         00966000
  double PortId;                                                        00967000
  integer pointer Context,Message;                                      00968000
  option forward;                                                       00969000
                                                                        00970000
procedure EnableIOWaitPort(IOWait'Index);                               00971000
  value IOWait'Index;                                                   00972000
  integer IOWait'Index;                                                 00973000
  option forward;  << NOT internal, but NOT in SPLINTR >>               00974000
                                                                        00975000
procedure DisableIOWaitPort(IOWait'Index);                              00976000
  value IOWait'Index;                                                   00977000
  integer IOWait'Index;                                                 00978000
  option forward;  << NOT internal, but NOT in SPLINTR >>               00979000
                                                                        00980000
procedure IOWaitDispatcher(IOWait'Index);                               00981000
  value IOWait'Index;                                                   00982000
  integer IOWait'Index;                                                 00983000
  option forward;  << NOT internal, but NOT in SPLINTR >>               00984000
                                                                        00985000
integer procedure Allocate'IOWait'index(PortId);                        00986000
  value PortId;                                                         00987000
  double PortId;                                                        00988000
  option forward;                                                       00989000
                                                                        00990000
procedure Release'IOWait'index(Index);                                  00991000
  value Index;                                                          00992000
  integer Index;                                                        00993000
  option forward;                                                       00994000
                                                                        00995000
procedure IOWaitPort'server(PortId,Context,Message);                    00996000
  value PortId,Context,Message;                                         00997000
  double PortId;                                                        00998000
  integer pointer Context,Message;                                      00999000
  option forward;                                                       01000000
$page                                                                   01001000
$control segment=port                                                   01002000
procedure IPCVersion( Version);                                         01003000
  byte array          Version;                                          01004000
  begin                                                                 01005000
$IF  X5=OFF                                                             01006000
    move Version := "A0105000";                                         01007000
$IF  X5=ON                                                              01008000
    move Version := "B0106000";                                         01009000
$IF                                                                     01010000
  end;                                                                  01011000
                                                                        01012000
logical procedure badDST(DSTno);                                        01013000
  value                  DSTno;                                         01014000
  integer                DSTno;                                         01015000
  option internal;                                                      01016000
  begin                                                                 01017000
    badDST := (DSTno < %70) LOR (DSTno >= INTEGER(DST(0))) LOR          01018000
              (INTEGER(DST(DSTno&LSL(2))) = %100000);                   01019000
  end;                                                                  01020000
$page "Wait/Awake for Msg"                                              01021000
procedure WaitForMsg;                                                   01022000
  begin                                                                 01023000
comment  This procedure is called with both interrupts disabled         01024000
    and process switching disabled.  The global define                  01025000
    "allocate'message'frame" is the usual caller, and will              01026000
    determine if we are executing in an environment that allows         01027000
    us to wait the process.  (e.g., not on the ICS and the              01028000
    pdisable counter was zero when the user called this code).          01029000
    **Note: Expects abs PortDST & Caller's DST as arguments by ref      01030000
  ;                                                                     01031000
  logical Pin;                                                          01032000
  integer PortDST;                                                      01033000
  double array AbsAddresses(*) = Q-7, AbsNewAddr(*) = Q;                01034000
  double AbsPortDB    = AbsAddresses,                                   01035000
         CallersDB    = AbsAddresses + 2,                               01036000
         AbsPortNewDB = AbsNewAddr,                                     01037000
         CallersNewDB = AbsNewAddr + 2;                                 01038000
                                                                        01039000
  PortDST := PortDSTnum;                                                01040000
  Pin := curpin;                                                        01041000
  if ProcHead = 0 then                                                  01042000
    begin  << first process to wait >>                                  01043000
    ProcHead := ProcTail := Pin;                                        01044000
    end                                                                 01045000
  else                                                                  01046000
    begin  << not first process, queue to tail >>                       01047000
$IF  X5=OFF                                                             01048000
    pcb(ProcTail * pcbsize + pcb'iqptr).iqptr := Pin;                   01049000
$IF  X5=ON                                                              01050000
    pcb(ProcTail * pcbsize + pcb'iqptr) := abs(cpcb);                   01051000
$IF                                                                     01052000
    ProcTail := Pin;                                                    01053000
    end;                                                                01054000
                                                                        01055000
  << make the new queuer's iqptr zero.  (should be zero already) >>     01056000
$IF  X5=OFF                                                             01057000
    pcb(pin*pcbsize+pcb'iqptr).iqptr := 0;                              01058000
$IF  X5=ON                                                              01059000
    pcb(pin*pcbsize+pcb'iqptr) := 0;                                    01060000
$IF                                                                     01061000
  bumpqpri(Pin,ProcHead);   << duplicate "impaired" >>                  01062000
  impede(0);                                                            01063000
  exchangedb'to'PortDST;  << restore original environment >>            01064000
  disable;                                                              01065000
  AbsPortDB := AbsPortNewDB;                                            01066000
  CallersDB := CallersNewDB;                                            01067000
                                                                        01068000
  end;                                                                  01069000
procedure AwakeForMsg;                                                  01070000
  begin                                                                 01071000
comment  This procedure is called with both interrupts disabled         01072000
    and process switching disabled.  The global define                  01073000
    "release'message'frame" is the usual caller.                        01074000
  ;                                                                     01075000
                                                                        01076000
  integer pcb'index,                                                    01077000
          nextpin;                                                      01078000
                                                                        01079000
  pcb'index := ProcHead*pcbsize;                                        01080000
$IF  X5=OFF                                                             01081000
  nextpin := pcb(pcb'index + pcb'iqptr).iqptr;                          01082000
$IF  X5=ON                                                              01083000
  nextpin := pcb(pcb'index + pcb'iqptr)/pcbsize;                        01084000
$IF                                                                     01085000
  if =                                                                  01086000
    then ProcHead := Proctail := 0  << only one process waiting >>      01087000
    else ProcHead := nextpin;  << new head process >>                   01088000
$IF  X5=OFF                                                             01089000
  pcb(pcb'index + pcb'iqptr).iqptr := 0;                                01090000
$IF  X5=ON                                                              01091000
  pcb(pcb'index + pcb'iqptr) := 0;                                      01092000
$IF                                                                     01093000
                                                                        01094000
  unimpede(pcb'index);                                                  01095000
  end;                                                                  01096000
$page "PortDispatcher"                                                  01097000
                                                                        01098000
procedure PortDispatcher(PortId);                                       01099000
  value PortId;                                                         01100000
  double PortId;                                                        01101000
  option privileged,uncallable,internal;                                01102000
  begin                                                                 01103000
<< Note: This procedure is called with interrupts disabled >>           01104000
<<       and does an exchangedb'back on behalf of the caller. >>        01105000
                                                                        01106000
  integer pointer Message,                                              01107000
                  msg;                                                  01108000
  integer Subqueue;                                                     01109000
  integer Old'DST,                                                      01110000
          max'msg'size,                                                 01111000
          context'ptr,                                                  01112000
          context'size,                                                 01113000
          T'PortCB'plabel;                                              01114000
  integer pointer T'PortCB'context;                                     01115000
  integer S0 = S-0;                                                     01116000
                                                                        01117000
  double AbsPortDB' = Q-9,   << caller has stacked Abs addr. >>         01118000
         CallersDB' = Q-7;                                              01119000
                                                                        01120000
  std'decl2;   << qhead/qtail >>                                        01121000
  std'decl;                                                             01122000
                                                                        01123000
  tos := AbsPortDB';  << pretend exchangedb'to'portdst was called >>    01124000
  tos := CallersDB';                                                    01125000
                                                                        01126000
  if PortCB'type.pdisabled then                                         01127000
    begin   << callable in any enviorment, including ICS >>             01128000
    << This code is duplicated in Send, PortEnable, and >>              01129000
    << PortMaskEnable primitives for performance reasons. >>            01130000
    << Therefore, it should never be called here. >>                    01131000
                                                                        01132000
    << run the server procedure >>                                      01133000
    PortCB'active := true;  << mutual exclusion semaphore >>            01134000
    dequeue'hipri'message;                                              01135000
    do begin                                                            01136000
      enable;                                                           01137000
      << actually run the server here >>                                01138000
      tos := PortId;                                                    01139000
      tos := PortCB'context;                                            01140000
      tos := @msg;                                                      01141000
      tos := PortCB'server'plabel;                                      01142000
      asmb( pcal 0 );                                                   01143000
                                                                        01144000
      << check for more messages >>                                     01145000
      disable;                                                          01146000
      if PortCB'enabled and not PortCB'delete                           01147000
        then dequeue'hipri'message                                      01148000
        else @msg := 0;                                                 01149000
    end until @msg = 0;                                                 01150000
                                                                        01151000
    PortCB'active := false;  << mutual exclusion no longer needed >>    01152000
    enable;                                                             01153000
    if PortCB'delete then                                               01154000
      begin                                                             01155000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             01156000
      DeletePort(PortId);                                               01157000
      end                                                               01158000
    else exchangedb'back;  << CallersDB/AbsPortDB is popped >>          01159000
    return;  << exit PortDispatcher >>                                  01160000
    end   << ICS-Port >>                                                01161000
  else                                                                  01162000
    begin   << callable in a penabled state >>                          01163000
    on'ics;  << tos = true if executing on the ics >>                   01164000
$IF  X5=OFF                                                             01165000
    if tos or abs(abs(cpcb) +2) < 0 then                                01166000
$IF  X5=ON                                                              01167000
    if tos or pcb(abs(cpcb) +2) < 0 then                                01168000
$IF                                                                     01169000
      begin << on the ICS, called pdisabled, or DB at SYSDB >>          01170000
      enable;                                                           01171000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             01172000
      tos := 3;   << Blocked I/O Subqueue, ignored >>                   01173000
      tos := 4;   << Length >>                                          01174000
      tos := PortId;                                                    01175000
      Send'S(FindProcessPort(SysPort'pin),3,4);                         01176000
      return;   << exit from PortDispatcher >>                          01177000
      end;                                                              01178000
    PortCB'active := true;  << mutual exclusion semaphore >>            01179000
    dequeue'hipri'message;                                              01180000
    enable;                                                             01181000
    if PortCB'type.DB'PortDST then                                      01182000
      begin  << callable with DB @ PortDST >>                           01183000
      << Simulate an "exchangedb'back" and an "exchangedb(PortDST)" >>  01184000
      asmb( subs 4 );  << CallersDB/AbsPortDB are popped >>             01185000
    x := to'xds;   << load index register with xds offset >>            01186000
    Old'DST := pcb'xds;                                                 01187000
    pcb'xds := PortDST;                                                 01188000
      penable;                                                          01189000
      do begin                                                          01190000
        enable;                                                         01191000
        << actually run the server here >>                              01192000
        tos := PortId;                                                  01193000
        tos := PortCB'context;                                          01194000
        tos := @msg;                                                    01195000
        tos := PortCB'server'plabel;                                    01196000
        asmb( pcal 0 );                                                 01197000
                                                                        01198000
        << check for more messages >>                                   01199000
        disable;                                                        01200000
        if PortCB'enabled and not PortCB'delete                         01201000
          then dequeue'hipri'message                                    01202000
          else @msg := 0;                                               01203000
      end until @msg = 0;                                               01204000
                                                                        01205000
      PortCB'active := false;  << mutual exclusion no longer needed >>  01206000
      enable;                                                           01207000
      if PortCB'delete then                                             01208000
        DeletePort(PortId);                                             01209000
      if Old'DST <> PortDST then exchangedb(Old'DST);                   01210000
      return;  << exit PortDispatcher >>                                01211000
      end   << penabled, DB @ PortDST port-type >>                      01212000
    else                                                                01213000
      begin   << callable in penabled state, DB @ StackDB >>            01214000
      max'msg'size := PortDSTMaxMsgSize;                                01215000
      context'ptr := PortCB'context;                                    01216000
      context'size := PortDSTMaxContextSize;                            01217000
      T'PortCB'plabel := PortCB'server'plabel;                          01218000
                                                                        01219000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             01220000
      Old'DST := exchangedb(0);                                         01221000
                                                                        01222000
      << make room for data structures on the stack >>                  01223000
      @Message := @S0 +1;                                               01224000
      tos := max'msg'size;                                              01225000
      asmb( adds 0 );  << allocate space for messages >>                01226000
                                                                        01227000
      if context'ptr = 0 then @T'PortCB'context := 0                    01228000
      else                                                              01229000
        begin   << copy the context area to the stack >>                01230000
        @T'PortCB'context := @S0 +1;                                    01231000
        tos := context'size;                                            01232000
        asmb( adds 0 );  << allocate space for context area >>          01233000
        tos := @T'PortCB'context;  << move context to stack >>          01234000
        tos := PortDST;                                                 01235000
        tos := context'ptr;                                             01236000
        tos := context'size;                                            01237000
        asmb( mfds 4 );                                                 01238000
        end;                                                            01239000
                                                                        01240000
      << simulate exchangedb'to'PortDST for first loop pass >>          01241000
      pdisable;                                                         01242000
      PUSH(DB);                                                         01243000
      asmb( ddup );                                                     01244000
                                                                        01245000
      do begin                                                          01246000
        enable;                                                         01247000
        exchangedb'back;                                                01248000
                                                                        01249000
        tos := @Message;   << copy message frame to stack >>            01250000
        tos := PortDST;                                                 01251000
        tos := @msg;                                                    01252000
        tos := max'msg'size;                                            01253000
        asmb( mfds 4 );                                                 01254000
                                                                        01255000
        << actually run the server here >>                              01256000
        tos := PortId;                                                  01257000
        tos := @T'PortCB'context;                                       01258000
        tos := @Message;                                                01259000
        tos := T'PortCB'plabel;                                         01260000
        asmb( pcal 0 );                                                 01261000
                                                                        01262000
        if context'ptr <> 0 then                                        01263000
          begin  << put a copy of the context back in the PortDST >>    01264000
          tos := PortDST;                                               01265000
          tos := context'ptr;                                           01266000
          tos := @T'PortCB'context;                                     01267000
          tos := context'size;                                          01268000
          asmb( mtds 4 );                                               01269000
          end;                                                          01270000
                                                                        01271000
        exchangedb'to'PortDST;                                          01272000
        release'message'frame;                                          01273000
                                                                        01274000
        << check for more messages >>                                   01275000
        disable;                                                        01276000
        if PortCB'enabled and not PortCB'delete                         01277000
          then dequeue'hipri'message                                    01278000
          else @msg := 0;                                               01279000
      end until @msg = 0;                                               01280000
                                                                        01281000
      PortCB'active := false;  << mutual exclusion no longer needed >>  01282000
      enable;                                                           01283000
      if PortCB'delete then                                             01284000
        begin                                                           01285000
        exchangedb'back;                                                01286000
        DeletePort(PortId);                                             01287000
        end                                                             01288000
      else exchangedb'back;                                             01289000
      if Old'DST <> 0 then exchangedb(Old'DST);                         01290000
      return;  << exit PortDispatcher >>                                01291000
      end;  << penabled, DB @ StackDB port-type >>                      01292000
                                                                        01293000
    end;   << callable penabled >>                                      01294000
  end;  << PortDispatcher >>                                            01295000
$page "Process Server Routines"                                         01296000
double procedure FindProcessPort(Pin);                                  01297000
  value Pin;                                                            01298000
  integer Pin;                                                          01299000
  option privileged,uncallable;                                         01300000
  begin                                                                 01301000
  integer PortDST = FindProcessPort,                                    01302000
          PortCB = PortDST +1;                                          01303000
                                                                        01304000
  if Pin = 0 then Pin := curpin;                                        01305000
  if Pin = -1 then Pin := 0;  << Dispatcher is Pin zero >>              01306000
                                                                        01307000
  PortDST := MsgHarbTabDSTN;                                            01308000
  PortCB := Pin * MsgHarbPortLength + MsgHarbHeaderSize;                01309000
  end;  << FindProcessPort >>                                           01310000
procedure SysPortServer;                                                01311000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 01312000
  begin                                                                 01313000
  << Note: this procedure is never called, but is procreated >>         01314000
  << as the outer block of a core resident process by initial. >>       01315000
                                                                        01316000
  double MyPortId,                                                      01317000
         SubqueueLength,  << first two words for 'receive' >>           01318000
         DelayedPortId;   << second two words for 'receive' >>          01319000
  integer Subqueue = Subqueuelength,                                    01320000
          Length = Subqueuelength +1,                                   01321000
          PortDST = DelayedPortId;                                      01322000
  integer msg'id = PortDST;                                             01323000
  integer pointer PortCB = DelayedPortId +1;                            01324000
                                                                        01325000
  MyPortId := FindProcessPort(0);                                       01326000
                                                                        01327000
  while true do  << do forever >>                                       01328000
    begin                                                               01329000
    ReceiveWait'S(MyPortId,4,-1);                                       01330000
    if not (0 <= Subqueue <= 3) then suddendeath(badport);              01331000
    case *Subqueue of                                                   01332000
      begin                                                             01333000
<<0>> suddendeath(badport);                                             01334000
<<1>> PortSeg'completor(msg'id);                                        01335000
<<2>> PortTimeOut(PortDST);                                             01336000
<<3>> PortEnable(DelayedPortId);                                        01337000
      end;                                                              01338000
    end;                                                                01339000
                                                                        01340000
  end;   << SysPortServer >>                                            01341000
$page "Send"                                                            01342000
                                                                        01343000
procedure Send'DB(PortId,Subqueue,Message);                             01344000
  value PortId,Subqueue,Message;                                        01345000
  double PortId;                                                        01346000
  integer Subqueue;                                                     01347000
  integer pointer Message;                                              01348000
  option privileged,uncallable;                                         01349000
                                                                        01350000
<< Note:  Message is really a Pascal type record.  The first >>         01351000
<<   word of message is the subqueue of the port to receive the >>      01352000
<<   message.  Note that subqueue is ignored by the Send >>             01353000
<<   primitives.  The second word is a positive word count of the >>    01354000
<<   message length, INCLUDING the two word header. >>                  01355000
  begin                                                                 01356000
comment  Algorithm:                                                     01357000
    Get a msg buffer from the free pool.                                01358000
    Move the caller's data into the msg buffer.                         01359000
    Queue the msg buffer to the port.                                   01360000
    If first msg in subqueue AND subqueue enabled AND                   01361000
       the port is enabled THEN  run the server procedure.              01362000
  ;                                                                     01363000
logical MsgMode;                                                        01364000
  entry Send'Q,   << secondary entry points >>                          01365000
        Send'S,                                                         01366000
        Send'Ref;                                                       01367000
                                                                        01368000
  integer array QM0array(*) = Q-0;                                      01369000
                                                                        01370000
  integer pointer msg;                                                  01371000
  integer Length;                                                       01372000
                                                                        01373000
  std'decl2;   << qhead/qtail >>                                        01374000
  std'decl;                                                             01375000
                                                                        01376000
                                                                        01377000
<< Send'DB :    primary entry point >>                                  01378000
    Length := Message(1);                                               01379000
    MsgMode := FALSE;                                                   01380000
    GOTO FillMsg;                                                       01381000
                                                                        01382000
Send'Q :   << secondary entry point >>                                  01383000
    @Message := @Message - deltaQ;  << fixup Message addr >>            01384000
    GOTO Scontinue;                                                     01385000
                                                                        01386000
Send'S :   << secondary entry point >>                                  01387000
    << in this case, @Message is really the length of the msg >>        01388000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 01389000
    << fall through into Scontinue >>                                   01390000
                                                                        01391000
Scontinue :                                                             01392000
    Length := QM0array(@Message +1);                                    01393000
    MsgMode := TRUE;                                                    01394000
                                                                        01395000
<<>>                                                                    01396000
                                                                        01397000
FillMsg :                                                               01398000
  exchangeDB'to'PortDST;                                                01399000
  allocate'message'frame;                                               01400000
  if @msg = 0 then suddendeath(badport);  << ICS only >>                01401000
                                                                        01402000
  if Length > PortDSTMaxMsgSize then  << +*+ >>                         01403000
    suddendeath(badportcall);  << +*+ >>                                01404000
  tos := AbsPortDB;     << move the data into the msg buffer >>         01405000
  tos := tos + @msg;                                                    01406000
  if MsgMode then begin CalcAbsQ end else TOS := CallersDB;             01407000
  TOS := TOS + @Message;                                                01408000
  tos := Length;                                                        01409000
  mabs5;  << perform an absolute move, and pop all parameters >>        01410000
                                                                        01411000
  goto enqueue'msg;                                                     01412000
                                                                        01413000
<<>>                                                                    01414000
                                                                        01415000
Send'Ref :   << secondary entry point >>                                01416000
  turn'traps'off;                                                       01417000
  pdisable;                                                             01418000
  PUSH(DB);   << simulate exchangedb'to'PortDST >>                      01419000
  asmb( ddup );  << NOTE: in this path, AbsMessage is NOT allocated! >> 01420000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       01421000
  Length := Message(1);  << +*+ >>                                      01422000
  if Length > PortDSTMaxMsgSize then  << +*+ >>                         01423000
    suddendeath(badportcall);  << +*+ >>                                01424000
                                                                        01425000
  @msg := @Message;                                                     01426000
  << fall through into enqueue'msg >>                                   01427000
                                                                        01428000
<<>>                                                                    01429000
                                                                        01430000
enqueue'msg :                                                           01431000
 if Subqueue > PortDSTMaxSubqueue then suddendeath(badportcall);        01432000
                << queue the message to the port >>                     01433000
  msg := 0;  << break msg link into free pool >>                        01434000
  disable;                                                              01435000
  << if PortCB'delete then suddendeath >>                               01436000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   01437000
  if @qhead <> 0 then                                                   01438000
    begin  << not the first message >>                                  01439000
    @qtail := qtail := @msg;  << queue to tail >>                       01440000
    PortCB'dbl(x) := dbl'ptrs;                                          01441000
    end                                                                 01442000
  else                                                                  01443000
    begin  << first message in the queue >>                             01444000
    tos := tos := @msg;  << queue to the front >>                       01445000
    PortCB'dbl(x) := tos;                                               01446000
    set'message'bit;  << set flags to indicate a msg is present >>      01447000
    end;                                                                01448000
                                                                        01449000
  tos := PortCB'dbl;   << load both flags and mask words >>             01450000
  asmb( and,del );                                                      01451000
  if <> and PortCB'enabled and not PortCB'active then                   01452000
    begin  << run the port procedure >>                                 01453000
    if not PortCB'type.pdisabled then                                   01454000
      begin                                                             01455000
      PortDispatcher(PortId);  << PortDisp will exchangedb'back! >>     01456000
      return;                                                           01457000
      end                                                               01458000
    else                                                                01459000
      begin   << callable in any enviorment, including ICS >>           01460000
      << This code is duplicated from PortDispatcher for >>             01461000
      << performance reasons. >>                                        01462000
                                                                        01463000
      << run the server procedure >>                                    01464000
      PortCB'active := true;  << mutual exclusion semaphore >>          01465000
      dequeue'hipri'message;                                            01466000
      do begin                                                          01467000
        enable;                                                         01468000
        << actually run the server here >>                              01469000
        tos := PortId;                                                  01470000
        tos := PortCB'context;                                          01471000
        tos := @msg;                                                    01472000
        tos := PortCB'server'plabel;                                    01473000
        asmb( pcal 0 );                                                 01474000
                                                                        01475000
        << check for more messages >>                                   01476000
        disable;                                                        01477000
        if PortCB'enabled and not PortCB'delete                         01478000
          then dequeue'hipri'message                                    01479000
          else @msg := 0;                                               01480000
      end until @msg = 0;                                               01481000
                                                                        01482000
      PortCB'active := false;  << mutual exclusion no longer needed >>  01483000
      enable;                                                           01484000
      if PortCB'delete then                                             01485000
        begin                                                           01486000
        exchangedb'back;  << CallersDB/AbsPortDB is popped >>           01487000
        DeletePort(PortId);                                             01488000
        end                                                             01489000
      else exchangedb'back;  << CallersDB/AbsPortDB is popped >>        01490000
      return;  << exit Send >>                                          01491000
      end;  << ICS-Port >>                                              01492000
                                                                        01493000
    end;  << done with running of the port procedure >>                 01494000
                                                                        01495000
   << port procedure not activated >>                                   01496000
  enable;                                                               01497000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01498000
  end;  << Send >>                                                      01499000
$page "Receive"                                                         01500000
procedure Receive'DB(PortId,Message,EnableMask);                        01501000
  value PortId,Message,EnableMask;                                      01502000
  double PortId;                                                        01503000
  integer pointer Message;                                              01504000
  logical EnableMask;                                                   01505000
  option privileged,uncallable;                                         01506000
                                                                        01507000
<< Note:  Message is really a Pascal type record.  The first >>         01508000
<<   word of message is the subqueue of the port to receive the >>      01509000
<<   message.  The second word is a positive word count of the >>       01510000
<<   message length, not including the two word header. >>              01511000
  begin                                                                 01512000
                                                                        01513000
comment  Algorithm:                                                     01514000
    Find the highest priority, enabled subqueue with a message.         01515000
    Dequeue the first msg from the subqueue.                            01516000
    Move the msg data to the caller's data area.                        01517000
    Return the msg back to the free pool.                               01518000
  ;                                                                     01519000
                                                                        01520000
  entry Receive'Q,                                                      01521000
        Receive'S;                                                      01522000
                                                                        01523000
  integer Subqueue;                                                     01524000
  logical OldMask;  << save the original subqueue enable state >>       01525000
  integer pointer msg;                                                  01526000
                                                                        01527000
  std'decl2;   << qhead/qtail >>                                        01528000
  std'decl;                                                             01529000
                                                                        01530000
                                                                        01531000
<< Receive'DB :    primary entry point >>                               01532000
    exchangedb'to'PortDST;                                              01533000
    tos := CallersDB;                                                   01534000
    tos := tos + @Message;  << initializes AbsMessage >>                01535000
    GOTO GetMsg;                                                        01536000
                                                                        01537000
Receive'Q :   << secondary entry point >>                               01538000
    @Message := @Message - deltaQ;  << fixup Message addr >>            01539000
    GOTO Scontinue;                                                     01540000
                                                                        01541000
Receive'S :   << secondary entry point >>                               01542000
    << in this case, @Message is really the length of the msg >>        01543000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 01544000
  << fall through into Scontinue >>                                     01545000
                                                                        01546000
Scontinue :                                                             01547000
    exchangedb'to'PortDST;                                              01548000
    CalcAbsQ;  << push absolute bank and address onto tos >>            01549000
    tos := tos + @Message;  << initializes AbsMessage >>                01550000
                                                                        01551000
<<>>                                                                    01552000
                                                                        01553000
GetMsg :        << find the highest priority subqueue >>                01554000
  disable;                                                              01555000
  OldMask := PortCB'mask;  << save a copy of the original state >>      01556000
  PortCB'mask := OldMask lor EnableMask;  << enable subqueues >>        01557000
  dequeue'hipri'message;                                                01558000
  PortCB'mask := OldMask;  << restore old subqueue enable state >>      01559000
  enable;                                                               01560000
                                                                        01561000
  if @msg = 0 then                                                      01562000
    begin  << return a nil indication >>                                01563000
    << AbsMessage is on tos >>                                          01564000
    tos := -1;  tos := 2;  << Subqueue = -1, Length = 2 >>              01565000
    asmb( sdea );                                                       01566000
    asmb( ddel );  << delete AbsMessage >>                              01567000
    end                                                                 01568000
  else                                                                  01569000
    begin       << return the message to the caller >>                  01570000
    tos := AbsMessage;                                                  01571000
    tos := AbsPortDB;                                                   01572000
    tos := tos + @msg;                                                  01573000
    tos := msg(msg'length);                                             01574000
    mabs5;  << perform an absolute move, and pop all parameters >>      01575000
    asmb( ddel );  << delete AbsMessage >>                              01576000
                                                                        01577000
    release'message'frame;  << return the msg back to the free pool >>  01578000
    end;                                                                01579000
                                                                        01580000
  << DB back to callers db >>                                           01581000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01582000
  end;  << Receive >>                                                   01583000
$page "Receive'Ref"                                                     01584000
integer procedure Receive'Ref(PortId,Dummy,EnableMask);                 01585000
  value PortId,Dummy,EnableMask;                                        01586000
  double PortId;                                                        01587000
  integer Dummy;  << serves only to standardize calling sequence >>     01588000
  logical EnableMask;                                                   01589000
  option privileged,uncallable;                                         01590000
                                                                        01591000
<< Note:  Message is really a Pascal type record.  The first >>         01592000
<<   word of message is the subqueue of the port to receive the >>      01593000
<<   message.  The second word is a positive word count of the >>       01594000
<<   message length, not including the two word header. >>              01595000
  begin                                                                 01596000
                                                                        01597000
comment  Algorithm:                                                     01598000
    Find the highest priority, enabled subqueue with a message.         01599000
    Dequeue the first msg from the subqueue.                            01600000
    Return a pointer to the message.                                    01601000
  ;                                                                     01602000
                                                                        01603000
  integer Subqueue;                                                     01604000
  logical OldMask;  << save the original subqueue enable state >>       01605000
  integer pointer msg = Receive'Ref;                                    01606000
                                                                        01607000
  std'decl2;   << qhead/qtail >>                                        01608000
  std'decl;                                                             01609000
                                                                        01610000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       01611000
  disable;                                                              01612000
  OldMask := PortCB'mask;  << save a copy of the original state >>      01613000
  PortCB'mask := OldMask lor EnableMask;  << enable subqueues >>        01614000
  dequeue'hipri'message;                                                01615000
  PortCB'mask := OldMask;  << restore old subqueue enable state >>      01616000
  enable;                                                               01617000
  end;  << Receive'Ref >>                                               01618000
$page "ReceiveWait"                                                     01619000
                                                                        01620000
<< Note: ReceiveWait is really one of the advanced level >>             01621000
<<       port procedure primitives. >>                                  01622000
                                                                        01623000
procedure ReceiveWait'server(PortId,Context,Message);                   01624000
  value PortId,Context,Message;                                         01625000
  double PortId;                                                        01626000
  integer pointer Context,Message;                                      01627000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 01628000
  << +*+ Need to add a procedure to create process-server Ports >>      01629000
  begin                                                                 01630000
  logical pointer PortCB = PortId +1;                                   01631000
  integer Subqueue;                                                     01632000
                                                                        01633000
  Subqueue := Message << (0) >>;                                        01634000
  << The following should probably be replaced >>                       01635000
  PortDisable(PortId);                                                  01636000
  Replace'Ref(PortId,Subqueue,Message);                                 01637000
  PortMaskEnable(PortId,1&csr(Subqueue +1));  << Re-enable mask >>      01638000
                                                                        01639000
  awake(integer(PortCB'pin)*pcbsize,msgwaitcode,nowait);                01640000
                                                                        01641000
  end;   << ReceiveWait'server >>                                       01642000
                                                                        01643000
procedure ReceiveWait'DB(PortId,Message,EnableMask);                    01644000
  value PortId,Message,EnableMask;                                      01645000
  double PortId;                                                        01646000
  integer pointer Message;                                              01647000
  logical EnableMask;                                                   01648000
  option privileged,uncallable;                                         01649000
                                                                        01650000
<< Note:  Message is really a Pascal type record.  The first >>         01651000
<<   word of message is the subqueue of the port to receive the >>      01652000
<<   message.  The second word is a positive word count of the >>       01653000
<<   message length, not including the two word header. >>              01654000
  begin                                                                 01655000
                                                                        01656000
comment  Algorithm:                                                     01657000
    Find the highest priority, enabled subqueue with a message.         01658000
    Dequeue the first msg from the subqueue.                            01659000
    Move the msg data to the caller's data area.                        01660000
    Return the msg back to the free pool.                               01661000
  ;                                                                     01662000
                                                                        01663000
  integer Subqueue;                                                     01664000
  logical MsgMode;  << used to indicate DB vs stack >>                  01665000
  logical OldMask;  << save the original subqueue enable state >>       01666000
  integer pointer msg;                                                  01667000
                                                                        01668000
  std'decl2;   << qhead/qtail >>                                        01669000
  std'decl;                                                             01670000
                                                                        01671000
  entry ReceiveWait'Q,                                                  01672000
        ReceiveWait'S;                                                  01673000
                                                                        01674000
                                                                        01675000
<< ReceiveWait'DB :    primary entry point >>                           01676000
    MsgMode := false;  << indicate DB relative message >>               01677000
    GOTO GetMsg;                                                        01678000
                                                                        01679000
ReceiveWait'Q :   << secondary entry point >>                           01680000
    @Message := @Message - deltaQ;  << fixup Message addr >>            01681000
    GOTO Scontinue;                                                     01682000
                                                                        01683000
ReceiveWait'S :   << secondary entry point >>                           01684000
    << in this case, @Message is really the length of the msg >>        01685000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 01686000
    << fall through into Scontinue >>                                   01687000
                                                                        01688000
Scontinue :                                                             01689000
    MsgMode := true;  << means that the message is stack relative >>    01690000
                                                                        01691000
<<>>                                                                    01692000
                                                                        01693000
GetMsg :        << find the highest priority subqueue >>                01694000
  exchangeDB'to'PortDST;                                                01695000
  disable;                                                              01696000
  OldMask := PortCB'mask;  << save a copy of the original state >>      01697000
  PortCB'mask := OldMask lor EnableMask;  << enable subqueues >>        01698000
  dequeue'hipri'message;                                                01699000
                                                                        01700000
  if @msg = 0 then                                                      01701000
    begin  << wait for a message! >>                                    01702000
    PortCB'server'plabel := @ReceiveWait'server;                        01703000
    PortCB'type := 3;  << server called pdisabled, DB @ PortDST >>      01704000
    PortCB'enabled := true;                                             01705000
    PortCB'pin := curpin;                                               01706000
    clearwws;  << clear previous awake flags >>                         01707000
    enable;                                                             01708000
                                                                        01709000
    exchangedb'back;  << CallersDB/AbsPortDB is popped >>               01710000
    wait(-msgwaitcode,noinfo);  << neg. means check WWS >>              01711000
    goto GetMsg;                                                        01712000
    end                                                                 01713000
  else                                                                  01714000
    begin       << return the message to the caller >>                  01715000
    PortCB'mask := OldMask;  << restore old subqueue enable state >>    01716000
    enable;                                                             01717000
    if MsgMode then begin CalcAbsQ end else TOS := CallersDB;           01718000
    TOS := TOS + @Message;                                              01719000
    tos := AbsPortDB;                                                   01720000
    tos := tos + @msg;                                                  01721000
    tos := msg(msg'length);                                             01722000
    mabs5;  << perform an absolute move, and pop all parameters >>      01723000
                                                                        01724000
                                                                        01725000
    release'message'frame;  << return the msg back to the free pool >>  01726000
    end;                                                                01727000
                                                                        01728000
  << DB back to callers db >>                                           01729000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01730000
  end;  << Receive >>                                                   01731000
$page "Replace"                                                         01732000
procedure Replace'DB(PortId,Subqueue,Message);                          01733000
  value PortId,Subqueue,Message;                                        01734000
  double PortId;                                                        01735000
  integer Subqueue;                                                     01736000
  integer pointer Message;                                              01737000
  option privileged,uncallable;                                         01738000
                                                                        01739000
<< Note:  Message is really a Pascal type record.  The first >>         01740000
<<   word of message is the subqueue of the port to receive the >>      01741000
<<   message.  Note that subqueue is ignored by the Replace >>          01742000
<<   primitives.  The second word is a positive word count of the >>    01743000
<<   message length, INCLUDING the two word header. >>                  01744000
  begin                                                                 01745000
comment  Algorithm:                                                     01746000
    Get a msg buffer from the free pool.                                01747000
    Move the caller's data into the msg buffer.                         01748000
    Queue the msg buffer to head of the port.                           01749000
    Disable the subqueue that the message is enqueued upon.             01750000
  ;                                                                     01751000
                                                                        01752000
  entry Replace'Q,   << secondary entry points >>                       01753000
        Replace'S,                                                      01754000
        Replace'Ref;                                                    01755000
                                                                        01756000
  integer array QM0array(*) = Q-0;                                      01757000
logical MsgMode;                                                        01758000
  integer pointer msg;                                                  01759000
  integer Length;                                                       01760000
                                                                        01761000
  std'decl2;   << qhead/qtail >>                                        01762000
  std'decl;                                                             01763000
                                                                        01764000
                                                                        01765000
<< Replace'DB :    primary entry point >>                               01766000
    Length := Message(1);                                               01767000
    MsgMode := FALSE;                                                   01768000
    GOTO FillMsg;                                                       01769000
                                                                        01770000
Replace'Q :   << secondary entry point >>                               01771000
    @Message := @Message - deltaQ;  << fixup Message addr >>            01772000
    GOTO Scontinue;                                                     01773000
                                                                        01774000
Replace'S :   << secondary entry point >>                               01775000
    << in this case, @Message is really the length of the msg >>        01776000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 01777000
  << fall through into Scontinue >>                                     01778000
                                                                        01779000
Scontinue :                                                             01780000
    Length := QM0array(@Message +1);                                    01781000
    MsgMode := TRUE;                                                    01782000
                                                                        01783000
<<>>                                                                    01784000
                                                                        01785000
FillMsg :                                                               01786000
  exchangeDB'to'PortDST;                                                01787000
  allocate'message'frame;                                               01788000
  if @msg = 0 then suddendeath(badport);  << ICS only >>                01789000
                                                                        01790000
  if Length > PortDSTMaxMsgSize then  << +*+ >>                         01791000
    suddendeath(badportcall);  << +*+ >>                                01792000
  tos := AbsPortDB;     << move the data into the msg buffer >>         01793000
  tos := tos + @msg;                                                    01794000
    if MsgMode then begin CalcAbsQ end else TOS := CallersDB;           01795000
    TOS := TOS + @Message;                                              01796000
  tos := Length;                                                        01797000
  mabs5;  << perform an absolute move, and pop all parameters >>        01798000
                                                                        01799000
  goto enqueue'msg;                                                     01800000
                                                                        01801000
<<>>                                                                    01802000
                                                                        01803000
Replace'Ref :   << secondary entry point >>                             01804000
  turn'traps'off;                                                       01805000
  pdisable;                                                             01806000
  PUSH(DB);   << simulate exchangedb'to'portdst >>                      01807000
  asmb( ddup );  << NOTE: in this path, AbsMessage is NOT allocated! >> 01808000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       01809000
  Length := Message(1);  << +*+ >>                                      01810000
  if Length > PortDSTMaxMsgSize then  << +*+ >>                         01811000
    suddendeath(badportcall);  << +*+ >>                                01812000
                                                                        01813000
  @msg := @Message;                                                     01814000
  << fall through into enqueue'msg >>                                   01815000
                                                                        01816000
<<>>                                                                    01817000
                                                                        01818000
enqueue'msg :                                                           01819000
 if Subqueue > PortDSTMaxSubqueue then suddendeath(badportcall);        01820000
                     << queue the message to the port >>                01821000
  disable;                                                              01822000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   01823000
  msg := @qhead;  << Link message to head of subqueue >>                01824000
  if = then                                                             01825000
    begin  << only message in the subqueue >>                           01826000
    tos := tos := @msg;  << update both head and tail pointers >>       01827000
    PortCB'dbl(x) := tos;                                               01828000
    set'message'bit;  << set flags to indicate a msg is present >>      01829000
    end                                                                 01830000
  else                                                                  01831000
    begin  << not the only message, but queue to front >>               01832000
    @qhead := @msg;                                                     01833000
    PortCB'dbl(x) := dbl'ptrs;                                          01834000
    end;                                                                01835000
                                                                        01836000
  << disable the subqueue >>                                            01837000
  tos := PortCB'mask;                                                   01838000
  x := Subqueue;                                                        01839000
  asmb( trbc 0,x );                                                     01840000
  PortCB'mask := tos;                                                   01841000
  enable;                                                               01842000
                                                                        01843000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01844000
  end;  << Replace >>                                                   01845000
$page "Discard and GetMessage"                                          01846000
procedure Discard'Ref(PortId,Message);                                  01847000
  value PortId,Message;                                                 01848000
  double PortId;                                                        01849000
  integer pointer Message;                                              01850000
  option privileged,uncallable;                                         01851000
                                                                        01852000
  begin                                                                 01853000
  integer pointer msg = Message;  << alias for defines >>               01854000
  std'decl;   << declare AbsDB variables >>                             01855000
                                                                        01856000
  turn'traps'off;   << simulate exchangedb to PortDST >>                01857000
  pdisable;                                                             01858000
  PUSH(DB);                                                             01859000
  asmb( ddup );                                                         01860000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       01861000
                                                                        01862000
  release'message'frame;                                                01863000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01864000
  end;  << Discard'Ref >>                                               01865000
                                                                        01866000
integer procedure GetMessage'Ref(PortId);                               01867000
  value PortId;                                                         01868000
  double PortId;                                                        01869000
  option privileged,uncallable;                                         01870000
                                                                        01871000
  begin                                                                 01872000
  integer pointer msg = GetMessage'Ref;                                 01873000
  std'decl;   << declare AbsDB variables >>                             01874000
                                                                        01875000
  turn'traps'off;   << simulate exchangedb to PortDST >>                01876000
  pdisable;                                                             01877000
  PUSH(DB);                                                             01878000
  asmb( ddup );                                                         01879000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       01880000
                                                                        01881000
  allocate'message'frame;                                               01882000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01883000
  end;  << Discard'Ref >>                                               01884000
$page "PortMaskDisable and PortMaskEnable"                              01885000
procedure PortMaskDisable(PortId,DisableMask);                          01886000
  value PortId,DisableMask;                                             01887000
  double PortId;                                                        01888000
  logical DisableMask;                                                  01889000
  option privileged,uncallable;                                         01890000
                                                                        01891000
  begin                                                                 01892000
  std'decl;                                                             01893000
                                                                        01894000
  exchangedb'to'PortDST;                                                01895000
                                                                        01896000
  disable;                                                              01897000
  PortCB'mask := PortCB'mask land not DisableMask;                      01898000
  enable;                                                               01899000
                                                                        01900000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01901000
  end;  << PortMaskDisable >>                                           01902000
                                                                        01903000
procedure PortMaskEnable(PortId,EnableMask);                            01904000
  value PortId,EnableMask;                                              01905000
  double PortId;                                                        01906000
  logical EnableMask;                                                   01907000
  option privileged,uncallable;                                         01908000
                                                                        01909000
  begin                                                                 01910000
  integer Subqueue;                                                     01911000
  integer pointer msg;                                                  01912000
                                                                        01913000
  std'decl2;   << qhead/qtail >>                                        01914000
  std'decl;                                                             01915000
                                                                        01916000
  exchangedb'to'PortDST;                                                01917000
                                                                        01918000
  disable;                                                              01919000
  PortCB'mask := PortCB'mask lor EnableMask;                            01920000
  << need to check if activation of port procedure necessary >>         01921000
  tos := PortCB'dbl;   << get both mask and flags >>                    01922000
  asmb( and,del );                                                      01923000
  if <> and PortCB'enabled and not PortCB'active then                   01924000
    begin  << run the port procedure >>                                 01925000
    if not PortCB'type.pdisabled then                                   01926000
      begin                                                             01927000
      PortDispatcher(PortId);  << PortDisp will exchangedb'back! >>     01928000
      return;                                                           01929000
      end                                                               01930000
    else                                                                01931000
      begin   << callable in any enviorment, including ICS >>           01932000
      << This code is duplicated from PortDispatcher for >>             01933000
      << performance reasons. >>                                        01934000
                                                                        01935000
      << run the server procedure >>                                    01936000
      PortCB'active := true;  << mutual exclusion semaphore >>          01937000
      dequeue'hipri'message;                                            01938000
      do begin                                                          01939000
        enable;                                                         01940000
        << actually run the server here >>                              01941000
        tos := PortId;                                                  01942000
        tos := PortCB'context;                                          01943000
        tos := @msg;                                                    01944000
        tos := PortCB'server'plabel;                                    01945000
        asmb( pcal 0 );                                                 01946000
                                                                        01947000
        << check for more messages >>                                   01948000
        disable;                                                        01949000
        if PortCB'enabled and not PortCB'delete                         01950000
          then dequeue'hipri'message                                    01951000
          else @msg := 0;                                               01952000
      end until @msg = 0;                                               01953000
                                                                        01954000
      PortCB'active := false;  << mutual exclusion no longer needed >>  01955000
      enable;                                                           01956000
      if PortCB'delete then                                             01957000
        begin                                                           01958000
        exchangedb'back;  << CallersDB/AbsPortDB is popped >>           01959000
        DeletePort(PortId);                                             01960000
        end                                                             01961000
      else exchangedb'back;  << CallersDB/AbsPortDB is popped >>        01962000
      return;  << exit PortMaskEnable >>                                01963000
      end;  << ICS-Port >>                                              01964000
    end;  << done with running of the port procedure >>                 01965000
  enable;                                                               01966000
                                                                        01967000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01968000
  end;  << PortMaskEnable >>                                            01969000
$page "PortDisable and PortEnable"                                      01970000
<< PortDisable and PortEnable should NOT be callable from >>            01971000
<< port procedures.  They are reserved for the advanced level >>        01972000
<< of ports.  (Or maybe process servers?) >>                            01973000
<< This restriction may have changed with the addition of >>            01974000
<< PortCB'active to destinguish enabled vs. active.  SF 7/2/82 >>       01975000
                                                                        01976000
logical procedure PortDisable(PortId);                                  01977000
  value PortId;                                                         01978000
  double PortId;                                                        01979000
  option privileged,uncallable;                                         01980000
                                                                        01981000
  begin                                                                 01982000
  std'decl;                                                             01983000
                                                                        01984000
  exchangedb'to'PortDST;                                                01985000
                                                                        01986000
  disable;                                                              01987000
  PortDisable := PortCB'enabled;                                        01988000
  PortCB'enabled := false;                                              01989000
  enable;                                                               01990000
                                                                        01991000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 01992000
  end;  << PortDisable >>                                               01993000
                                                                        01994000
logical procedure PortEnable(PortId);                                   01995000
  value PortId;                                                         01996000
  double PortId;                                                        01997000
  option privileged,uncallable;                                         01998000
                                                                        01999000
  begin                                                                 02000000
  integer Subqueue;                                                     02001000
  integer pointer msg;                                                  02002000
                                                                        02003000
  std'decl2;   << qhead/qtail >>                                        02004000
  std'decl;                                                             02005000
                                                                        02006000
  exchangedb'to'PortDST;                                                02007000
                                                                        02008000
  disable;                                                              02009000
  PortEnable := PortCB'enabled;                                         02010000
  PortCB'enabled := true;                                               02011000
  << need to check if activation of port procedure necessary >>         02012000
  tos := PortCB'dbl;   << get both mask and flags >>                    02013000
  asmb( and,del );                                                      02014000
  if <> <<and PortCB'enabled>> and not PortCB'active then               02015000
    begin  << run the port procedure >>                                 02016000
    if not PortCB'type.pdisabled then                                   02017000
      begin                                                             02018000
      PortDispatcher(PortId);  << PortDisp will exchangedb'back! >>     02019000
      return;                                                           02020000
      end                                                               02021000
    else                                                                02022000
      begin   << callable in any enviorment, including ICS >>           02023000
      << This code is duplicated from PortDispatcher for >>             02024000
      << performance reasons. >>                                        02025000
                                                                        02026000
      << run the server procedure >>                                    02027000
      PortCB'active := true;  << mutual exclusion semaphore >>          02028000
      dequeue'hipri'message;                                            02029000
      do begin                                                          02030000
        enable;                                                         02031000
        << actually run the server here >>                              02032000
        tos := PortId;                                                  02033000
        tos := PortCB'context;                                          02034000
        tos := @msg;                                                    02035000
        tos := PortCB'server'plabel;                                    02036000
        asmb( pcal 0 );                                                 02037000
                                                                        02038000
        << check for more messages >>                                   02039000
        disable;                                                        02040000
        if PortCB'enabled and not PortCB'delete                         02041000
          then dequeue'hipri'message                                    02042000
          else @msg := 0;                                               02043000
      end until @msg = 0;                                               02044000
                                                                        02045000
      PortCB'active := false;  << mutual exclusion no longer needed >>  02046000
      enable;                                                           02047000
      if PortCB'delete then                                             02048000
        begin                                                           02049000
        exchangedb'back;  << CallersDB/AbsPortDB is popped >>           02050000
        DeletePort(PortId);                                             02051000
        end                                                             02052000
      else exchangedb'back;  << CallersDB/AbsPortDB is popped >>        02053000
      return;  << exit PortEnable >>                                    02054000
      end;  << ICS-Port >>                                              02055000
    end;  << done with running of the port procedure >>                 02056000
  enable;                                                               02057000
                                                                        02058000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02059000
  end;  << PortEnable >>                                                02060000
$page "NewPortStatus"                                                   02061000
integer procedure NewPortStatus(PortId,Type);                           02062000
  value PortId,Type;                                                    02063000
  double PortId;                                                        02064000
  integer Type;                                                         02065000
  option privileged,uncallable;                                         02066000
                                                                        02067000
  begin                                                                 02068000
  std'decl;                                                             02069000
                                                                        02070000
  exchangedb'to'PortDST;                                                02071000
                                                                        02072000
  case Type of                                                          02073000
    begin                                                               02074000
<<0>> NewPortStatus := PortCB'flags;                                    02075000
<<1>> NewPortStatus := PortCB'mask;                                     02076000
<<2>> NewPortStatus := PoolCnt;  << should be a diff procedure >>       02077000
    end;                                                                02078000
                                                                        02079000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02080000
  end;  << NewPortStatus >>                                             02081000
integer procedure SoftIntPlabel(PortId);                                02082000
  value PortId;                                                         02083000
  double PortId;                                                        02084000
  option privileged,uncallable;                                         02085000
                                                                        02086000
  begin                                                                 02087000
  << NOTE: must be called on stack assoc. with port >>                  02088000
  << NOTE: must be called with DB at stack DB >>                        02089000
  integer pointer Context;                                              02090000
  std'decl;                                                             02091000
                                                                        02092000
  exchangedb'to'PortDST;                                                02093000
  @Context := PortCB'context;                                           02094000
                                                                        02095000
  SoftIntPlabel := IOWait'softint'plabel;                               02096000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02097000
                                                                        02098000
  end;   << SoftIntPlabel  >>                                           02099000
$page "CreatePort"                                                      02100000
                                                                        02101000
double procedure CreatePort(ClassName,PortDST,NewFrames);               02102000
  value PortDST,NewFrames;                                              02103000
  byte array ClassName;                                                 02104000
  integer PortDST,NewFrames;                                            02105000
  option privileged,uncallable;                                         02106000
                                                                        02107000
  begin                                                                 02108000
  double PortId;                                                        02109000
  integer pointer PortCB = PortId +1;                                   02110000
  integer Result;                                                       02111000
  array Name(0:7);  << massaged ClassName >>                            02112000
  integer array DictData(0:7) = Q;                                      02113000
  integer DictPlabel = DictData +0,                                     02114000
          DictType   = DictData +1,                                     02115000
          DictContext= DictData +2,                                     02116000
          DictMsgSize= DictData +3,                                     02117000
          DictNumSubqueues = DictData +4;                               02118000
                                                                        02119000
  CreatePort := 0D;                                                     02120000
  GenerateDictName(ClassName,Name);                                     02121000
                                                                        02122000
  DictFind(Name,DictData,Result);                                       02123000
  if Result <> 0 then return;                                           02124000
                                                                        02125000
CreatePort'(PortDST, DictType, DictPlabel, DictNumSubqueues,            02126000
            DictContext, PortId, Result);                               02127000
  CreatePort := PortId;                                                 02128000
                                                                        02129000
  end;   << CreatePort >>                                               02130000
                                                                        02131000
procedure CreatePort'(PortDST, Type, Plabel, NumSubqueues, ContextSize, 02132000
                      PortId',  Result);                                02133000
  value               PortDST, Type, Plabel, NumSubqueues, ContextSize; 02134000
  integer     Result, PortDST, Type, Plabel, NumSubqueues, ContextSize; 02135000
  double              PortId';                                          02136000
  option privileged, uncallable;                                        02137000
                                                                        02138000
  begin                                                                 02139000
  equate  badparm1 = 1,                                                 02140000
          badparm2 = 2,                                                 02141000
          badparm4 = 4,                                                 02142000
          badparm5 = 5,                                                 02143000
          splitstk = 10;                                                02144000
  double PortId;                                                        02145000
  integer PortDSTx = PortId, Status;                                    02146000
  integer pointer PortCB = PortId + 1,                                  02147000
                  msg;                                                  02148000
                                                                        02149000
    Result  := 0;                                                       02150000
    PortId' := 0D;                                                      02151000
    if badDST(PortDST) then                                             02152000
      begin Result := badparm1; go to Exit; end;                        02153000
    Wheres'DB;                                                          02154000
    if <> then                                                          02155000
      begin Result := splitstk; go to Exit; end;                        02156000
    if Type.(0:13) <> 0 then                                            02157000
      begin Result := badparm2; go to Exit; end;                        02158000
    exchangedb'to'PortDST;                                              02159000
    Status := 0;                                                        02160000
    if not (0 <= NumSubqueues <= PortDSTMaxSubqueue + 1) then           02161000
      begin Status := badparm4; go to Done; end;                        02162000
    if not (0 <= ContextSize <= PortDSTMaxContextSize) then             02163000
      begin Status := badparm5; go to Done; end;                        02164000
    PortDSTx := PortDST;                                                02165000
    allocate'message'frame;                                             02166000
    @PortCB := @msg;                                                    02167000
                                                                        02168000
    << zero out message frame >>                                        02169000
    PortCB := 0;                                                        02170000
    move PortCB(1) :=                                                   02171000
         PortCB,((SubqueuesOffset + PortDSTMaxSubqueue)&LSL(1) + 1);    02172000
                                                                        02173000
    << initialize context area >>                                       02174000
    if ContextSize = 0 then PortCB'context := 0                         02175000
    else                                                                02176000
      begin                                                             02177000
      allocate'message'frame;                                           02178000
      PortCB'context := @msg;                                           02179000
      msg := 0;                                                         02180000
      move msg(1) := msg,(PortDSTMaxContextSize - 1);                   02181000
      end;                                                              02182000
                                                                        02183000
    PortCB'server'plabel := Plabel;                                     02184000
    PortCB'type := Type;                                                02185000
    PortCB'pin  := curpin;                                              02186000
                                                                        02187000
Done: exchangedb'back;                                                  02188000
    PortId' := PortId;                                                  02189000
    Result := Status;                                                   02190000
Exit: end;                                                              02191000
$page "TerminatePort"                                                   02192000
procedure TerminatePort(PortId);                                        02193000
  value PortId;                                                         02194000
  double PortId;                                                        02195000
  option privileged,uncallable;                                         02196000
                                                                        02197000
  begin                                                                 02198000
  std'decl;                                                             02199000
                                                                        02200000
  exchangedb'to'PortDST;                                                02201000
  disable;                                                              02202000
  << if not PortCB'active then suddendeath >>                           02203000
  PortCB'delete := true;  << mark as delete pending >>                  02204000
  enable;                                                               02205000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02206000
                                                                        02207000
  end;   << TerminatePort >>                                            02208000
$page "DeletePort"                                                      02209000
procedure DeletePort(PortId);                                           02210000
  value PortId;                                                         02211000
  double PortId;                                                        02212000
  option privileged,uncallable;                                         02213000
                                                                        02214000
  begin                                                                 02215000
  integer pointer msg;                                                  02216000
  integer pointer context;                                              02217000
  integer Subqueue,                                                     02218000
          aftioqx := 0;                                                 02219000
                                                                        02220000
  std'decl2;   << qhead/qtail >>                                        02221000
  std'decl;                                                             02222000
  integer pointer IntPortCB = PortCB;  << declared in std'decl >>       02223000
                                                                        02224000
  exchangedb'to'PortDST;                                                02225000
                                                                        02226000
  disable;                                                              02227000
  << if PortCB'active then suddendeath >>                               02228000
  PortCB'enabled := false;                                              02229000
  PortCB'mask := -1;                                                    02230000
                                                                        02231000
  dequeue'hipri'message;                                                02232000
  while @msg <> 0 do                                                    02233000
    begin                                                               02234000
    release'message'frame;                                              02235000
    disable;  << release'message'frame does an enable! >>               02236000
    dequeue'hipri'message;                                              02237000
    end;                                                                02238000
  enable;                                                               02239000
  case PortCB'subtype of                                                02240000
    begin                                                               02241000
                                                                        02242000
    begin  << subtype 0.  "normal" ports >>                             02243000
    if (@msg := PortCB'context) <> 0 then                               02244000
      release'message'frame;                                            02245000
    end;  << 0 >>                                                       02246000
                                                                        02247000
    begin  << subtype 1.  Semaphore ports >>                            02248000
    << Semaphore ports have no context area >>                          02249000
    if SemaphoreCnt <> 0 then suddendeath(badportcall);                 02250000
    end;                                                                02251000
                                                                        02252000
    begin  << subtype 2.  IOWait ports >>                               02253000
    @context := PortCB'context;                                         02254000
    if IOWait'count <> 0 then suddendeath(badportcall);                 02255000
    aftioqx := IOWait'aftioqx;                                          02256000
    @msg := @context;                                                   02257000
    release'message'frame;                                              02258000
    end;  << 1 >>                                                       02259000
                                                                        02260000
    end;  << subtype case stmt >>                                       02261000
                                                                        02262000
  @msg := @PortCB;                                                      02263000
  release'message'frame;                                                02264000
                                                                        02265000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02266000
  if aftioqx <> 0 then                                                  02267000
    Release'IOWait'index(aftioqx);                                      02268000
                                                                        02269000
  end;   << DeletePort >>                                               02270000
$page "AddPortClassName - DeletePortClassName"                          02271000
procedure GenerateDictname(ClassName,DictName);                         02272000
  byte array ClassName;                                                 02273000
  array DictName;                                                       02274000
  option privileged,uncallable,internal;                                02275000
  begin                                                                 02276000
  integer length;                                                       02277000
  byte array BDict(*) = DictName;                                       02278000
  equate PortDict'Type = 6;  << NetMgt administered >>                  02279000
                                                                        02280000
                                                                        02281000
  length := 0;                                                          02282000
  while length < 14 and ClassName(length) <> " " do                     02283000
    begin                                                               02284000
    BDict(length+2) := ClassName(length);                               02285000
    length := length +1;                                                02286000
    end;                                                                02287000
  BDict := length +1;                                                   02288000
  BDict(1) := PortDict'Type;                                            02289000
                                                                        02290000
  end;   << GenerateDictName >>                                         02291000
procedure AddPortClassName(ClassName,Plabel,Type,SubType,               02292000
                                ContextSize,MsgSize,NumSubqueues);      02293000
  value Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;           02294000
  byte array ClassName;                                                 02295000
  integer Plabel,Type,SubType,ContextSize,MsgSize,NumSubqueues;         02296000
  option privileged,uncallable;                                         02297000
  begin                                                                 02298000
  integer Result;                                                       02299000
  array Name(0:7);  << massaged ClassName >>                            02300000
  integer array DictData(0:7) = Q;                                      02301000
  integer DictPlabel = DictData +0,                                     02302000
          DictType   = DictData +1,                                     02303000
          DictContext= DictData +2,                                     02304000
          DictMsgSize= DictData +3,                                     02305000
          DictNumSubqueues = DictData +4;                               02306000
                                                                        02307000
  DictPlabel := Plabel;                                                 02308000
  DictType := SubType&lsl(8) + Type.(8:8);                              02309000
  DictContext := ContextSize;                                           02310000
  DictMsgSize := MsgSize;                                               02311000
  DictNumSubqueues := NumSubqueues;                                     02312000
                                                                        02313000
  GenerateDictName(ClassName,Name);                                     02314000
  DictAdd(Name,DictData,Result);                                        02315000
                                                                        02316000
  end;   << AddPortClassName >>                                         02317000
procedure DeletePortClassName(ClassName);                               02318000
  byte array ClassName;                                                 02319000
  option privileged,uncallable;                                         02320000
  begin                                                                 02321000
  integer Result;                                                       02322000
  integer array Dummy(0:0);                                             02323000
  array Name(0:7);                                                      02324000
                                                                        02325000
  GenerateDictName(ClassName,Name);                                     02326000
  DictDelete(Name,Dummy,Result);                                        02327000
                                                                        02328000
  end;   << DeletePortClassName >>                                      02329000
$page "InitPortDST"                                                     02330000
integer procedure InitPortDST(PortDST,MaxSubqueues,                     02331000
                                NumMessages,MaxMsgSize,                 02332000
                                MaxContextSize,                         02333000
                                UserReservedRegionSize);                02334000
  value PortDST,MaxSubqueues,                                           02335000
          NumMessages,MaxMsgSize,                                       02336000
          MaxContextSize,                                               02337000
          UserReservedRegionSize;                                       02338000
  integer PortDST,MaxSubqueues,                                         02339000
            NumMessages,MaxMsgSize,                                     02340000
            MaxContextSize,                                             02341000
            UserReservedRegionSize;                                     02342000
  option privileged,uncallable;                                         02343000
                                                                        02344000
  begin                                                                 02345000
                                                                        02346000
  integer UnitSize;                                                     02347000
  integer pointer msg;                                                  02348000
                                                                        02349000
  InitPortDST := 0;                                                     02350000
  if exchangedb(PortDST) <> 0 then suddendeath(wrongDST);               02351000
                                                                        02352000
  << Init port dst header to zeros. >>                                  02353000
  @msg := 0;                                                            02354000
  msg := 0;                                                             02355000
  move msg(1) := msg,(PortDSTHeaderSize-1);                             02356000
                                                                        02357000
  PortDSTnum := PortDST;                                                02358000
  @MsgPoolHead := @MsgPoolTail := 0;                                    02359000
  PoolCnt := 0;                                                         02360000
  ProcHead := ProcTail := 0;                                            02361000
  PortDSTsize := DST'Size(PortDST);                                     02362000
                                                                        02363000
  @UserRegionPointer := PortDSTHeaderSize;                              02364000
  if UserReservedRegionSize > 0 then                                    02365000
    InitPortDST := @UserRegionPointer;                                  02366000
  PortDSTMaxSubqueue := MaxSubqueues - 1;                               02367000
  PortDSTMaxMsgSize := MaxMsgSize;                                      02368000
  PortDSTMaxContextSize := MaxContextSize;                              02369000
                                                                        02370000
  @msg := @UserRegionPointer(UserReservedRegionSize);                   02371000
  << UnitSize := max(PortSize,MsgSize,ContextSize);  >>                 02372000
  UnitSize := (SubqueuesOffset + MaxSubqueues)*2;                       02373000
  if UnitSize < MaxContextSize then UnitSize := MaxContextSize;         02374000
  if UnitSize < MaxMsgSize then UnitSize := MaxMsgSize;                 02375000
                                                                        02376000
  while @msg <= PortDSTsize - UnitSize do                               02377000
    begin                                                               02378000
    release'message'frame;                                              02379000
    @msg := @msg + UnitSize;                                            02380000
    end;                                                                02381000
                                                                        02382000
  << reserve some for the emergency pool >>                             02383000
  PoolCnt := PoolCnt - NumMessages;                                     02384000
  if < then PoolCnt := 0;                                               02385000
  exchangedb(0);                                                        02386000
  end;   << InitPortDST >>                                              02387000
$page "InitPortDST'"                                                    02388000
procedure InitPortDST'(PrimaryPool, SecondaryPool, MaxMsgSize,          02389000
                       MaxPorts, MaxSubqueues, MaxContextSize,          02390000
                       UserRegSize, UserRegOffset, PortDST');           02391000
                                                                        02392000
  value                PrimaryPool, SecondaryPool, MaxMsgSize,          02393000
                       MaxPorts, MaxSubqueues, MaxContextSize,          02394000
                       UserRegSize;                                     02395000
                                                                        02396000
  integer              PrimaryPool, SecondaryPool, MaxMsgSize,          02397000
                       MaxPorts, MaxSubqueues, MaxContextSize,          02398000
                       UserRegSize, PortDST';                           02399000
integer pointer                     UserRegOffset;                      02400000
  option privileged,uncallable;                                         02401000
                                                                        02402000
  begin                                                                 02403000
  integer UnitSize, PortSegSize, PortDST, Result;                       02404000
  integer pointer msg;                                                  02405000
  equate badparm5 = 5,                                                  02406000
         dstoobig = 11,                                                 02407000
         splitstk = 10;                                                 02408000
                                                                        02409000
  Result  := 0;                                                         02410000
  PortDST := 0;                                                         02411000
  Wheres'DB;                                                            02412000
  if <> then begin Result := splitstk; go to Exit; end;                 02413000
  if not (1 <= MaxSubqueues <= 16) then                                 02414000
    begin Result := badparm5; go to Exit; end;                          02415000
                                                                        02416000
  UnitSize := (SubqueuesOffset + MaxSubqueues)&LSL(1);                  02417000
  if UnitSize < MaxMsgSize     then UnitSize := MaxMsgSize;             02418000
  if UnitSize < MaxContextSize then UnitSize := MaxContextSize;         02419000
  PortSegSize := PortDSTHeaderSize + UserRegSize +                      02420000
                 UnitSize*(MaxPorts + PrimaryPool + SecondaryPool);     02421000
  if MaxContextSize > 0 then                                            02422000
                 PortSegSize := PortSegSize + UnitSize*MaxPorts;        02423000
  if OVERFLOW then begin Result := dstoobig; go to Exit; end;           02424000
                                                                        02425000
  PortDST := GetDataSeg(PortSegSize, PortSegSize);                      02426000
  exchangedb(PortDST);                                                  02427000
                                                                        02428000
  << Init port dst header to zeros. >>                                  02429000
  @msg := 0;                                                            02430000
  msg := 0;                                                             02431000
  move msg(1) := msg,(PortDSTHeaderSize-1);                             02432000
                                                                        02433000
  PortDSTnum := PortDST;                                                02434000
  PortDSTsize := DST'Size(PortDST);                                     02435000
                                                                        02436000
  @UserRegionPointer := PortDSTHeaderSize;                              02437000
  PortDSTMaxSubqueue := MaxSubqueues - 1;                               02438000
  PortDSTMaxMsgSize := MaxMsgSize;                                      02439000
  PortDSTMaxContextSize := MaxContextSize;                              02440000
                                                                        02441000
  @msg := @UserRegionPointer(UserRegSize);                              02442000
  while @msg <= PortDSTsize - UnitSize do                               02443000
    begin                                                               02444000
    release'message'frame;                                              02445000
    @msg := @msg + UnitSize;                                            02446000
    end;                                                                02447000
                                                                        02448000
  << reserve some for the emergency pool >>                             02449000
  PoolCnt := PoolCnt - SecondaryPool;                                   02450000
                                                                        02451000
  exchangedb(0);                                                        02452000
 @UserRegOffset := if Result <> 0 then Result                           02453000
              else if UserRegSize > 0 then PortDSTHeaderSize            02454000
              else 0;                                                   02455000
  PortDST' := PortDST;                                                  02456000
Exit:  end;   << InitPortDST >>                                         02457000
$page "UpSemaphore"                                                     02458000
procedure UpSemaphore(SemaphoreId);                                     02459000
  value SemaphoreId;                                                    02460000
  double SemaphoreId;                                                   02461000
  option privileged,uncallable;                                         02462000
                                                                        02463000
<< Note:  Message is really a Pascal type record.  The first >>         02464000
<<   word of message is the subqueue of the port to receive the >>      02465000
<<   message.  Note that subqueue is ignored by the DownSemaphore >>    02466000
<<   primitives.  The second word is a positive word count of the >>    02467000
<<   message length, INCLUDING the two word header. The third and >>    02468000
<<   thru the fifth words are the reply PortId and subqueue of the >>   02469000
<<   where the resource granted message should be sent. >>              02470000
  begin                                                                 02471000
comment  Algorithm:                                                     02472000
    Increment the semaphore count variable.                             02473000
    If the old count is positive, no special action is needed,          02474000
      as the resource is available.                                     02475000
    If the old count is negitive, the highest priority message          02476000
      is dequeued, and sent to the reply port and subqueue              02477000
      indicated in the message frame.                                   02478000
  ;                                                                     02479000
  double PortId = SemaphoreId;  << all defines use PortId >>            02480000
  integer pointer msg;                                                  02481000
  double pointer Dmsg = msg;                                            02482000
  integer Subqueue;                                                     02483000
                                                                        02484000
  std'decl2;   << qhead/qtail >>                                        02485000
  std'decl;                                                             02486000
  integer pointer IntPortCB = PortCB;  << declared in std'decl >>       02487000
                                                                        02488000
  exchangedb'to'PortDST;                                                02489000
  disable;                                                              02490000
  SemaphoreCnt := SemaphoreCnt +1;                                      02491000
  if > then enable  << nobody waiting for the resource >>               02492000
  else                                                                  02493000
    begin  << send a Reply message granting the resource >>             02494000
    dequeue'hipri'message;                                              02495000
    enable;                                                             02496000
    if msg(2) = PortDST then Send'Ref(Dmsg(1),msg(4),msg)               02497000
    else                                                                02498000
      begin                                                             02499000
      Send'DB(Dmsg(1),msg(4),msg);                                      02500000
      release'message'frame;                                            02501000
      end;                                                              02502000
    end;                                                                02503000
                                                                        02504000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02505000
  end;  << UpSemaphore >>                                               02506000
$page "DownSemaphore"                                                   02507000
procedure DownSemaphore'DB(SemaphoreId,Subqueue,Message);               02508000
  value SemaphoreId,Subqueue,Message;                                   02509000
  double SemaphoreId;                                                   02510000
  integer Subqueue;                                                     02511000
  integer pointer Message;                                              02512000
  option privileged,uncallable;                                         02513000
                                                                        02514000
<< Note:  Message is really a Pascal type record.  The first >>         02515000
<<   word of message is the subqueue of the port to receive the >>      02516000
<<   message.  Note that subqueue is ignored by the DownSemaphore >>    02517000
<<   primitives.  The second word is a positive word count of the >>    02518000
<<   message length, INCLUDING the two word header. The third and >>    02519000
<<   thru the fifth words are the reply PortId and Subqueue of the >>   02520000
<<   where the resource granted message should be sent. >>              02521000
  begin                                                                 02522000
                                                                        02523000
comment  Algorithm:                                                     02524000
    Get a msg buffer from the free pool.                                02525000
    Move the caller's data into the msg buffer.                         02526000
    Decrement the semaphore count variable.                             02527000
    If the new count is positive, send the reply message immeadiatly,   02528000
    If the new count is negitive, the message is queued upon the        02529000
      semaphore port, and a future UpSemaphore will dequeue it and      02530000
      send it to the reply port.                                        02531000
  ;                                                                     02532000
                                                                        02533000
  entry DownSemaphore'Q,   << secondary entry points >>                 02534000
        DownSemaphore'S,                                                02535000
        DownSemaphore'Ref;                                              02536000
                                                                        02537000
  integer array QM0array(*) = Q-0;                                      02538000
                                                                        02539000
  double PortId = SemaphoreId;                                          02540000
  integer pointer msg;                                                  02541000
  double pointer Dmsg = msg;                                            02542000
  double pointer DMessage = Message;                                    02543000
  integer Length;                                                       02544000
                                                                        02545000
  std'decl2;   << qhead/qtail >>                                        02546000
  std'decl;                                                             02547000
  integer pointer IntPortCB = PortCB;  << declared in std'decl >>       02548000
                                                                        02549000
                                                                        02550000
<< DownSemaphore'DB :    primary entry point >>                         02551000
    Length := Message(1);                                               02552000
    exchangedb'to'PortDST;                                              02553000
    if Length > PortDSTMaxMsgSize then  << +*+ >>                       02554000
      suddendeath(badportcall);  << +*+ >>                              02555000
                                                                        02556000
    allocate'message'frame;  << must get frame now, disabled later >>   02557000
    if @msg = 0 then suddendeath(badport);  << ICS only >>              02558000
                                                                        02559000
    disable;                                                            02560000
    SemaphoreCnt := SemaphoreCnt -1;                                    02561000
    if >= then                                                          02562000
      begin  << request granted immeadiatly >>                          02563000
      enable;                                                           02564000
      release'message'frame;  << didn't need it after all >>            02565000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             02566000
      Send'DB(DMessage(1),Message(4),Message);                          02567000
      return;   << exit from DownSemaphore >>                           02568000
      end;                                                              02569000
    << must stay disabled thru enqueue'msg >>                           02570000
    tos := CallersDB;                                                   02571000
    tos := tos + @Message;  << initializes AbsMessage >>                02572000
    GOTO FillMsg;                                                       02573000
                                                                        02574000
DownSemaphore'Q :   << secondary entry point >>                         02575000
    @Message := @Message - deltaQ;  << fixup Message addr >>            02576000
    GOTO Scontinue;                                                     02577000
                                                                        02578000
DownSemaphore'S :   << secondary entry point >>                         02579000
    << in this case, @Message is really the length of the msg >>        02580000
    @Message := -(@Message + 7);  << form Qrel. addr >>                 02581000
    << fall through into Scontinue >>                                   02582000
                                                                        02583000
Scontinue :                                                             02584000
    << set msgdbl the hard way >>                                       02585000
    Length := QM0array(@Message +1);                                    02586000
    exchangedb'to'PortDST;                                              02587000
    if Length > PortDSTMaxMsgSize then  << +*+ >>                       02588000
      suddendeath(badportcall);  << +*+ >>                              02589000
                                                                        02590000
    allocate'message'frame;  << must get frame now, disabled later >>   02591000
    if @msg = 0 then suddendeath(badport);  << ICS only >>              02592000
                                                                        02593000
    disable;                                                            02594000
    SemaphoreCnt := SemaphoreCnt -1;                                    02595000
    if >= then                                                          02596000
      begin  << request granted immeadiatly >>                          02597000
      enable;                                                           02598000
      release'message'frame;  << didn't need it after all >>            02599000
      exchangedb'back;  << CallersDB/AbsPortDB is popped >>             02600000
      tos := QM0array(@Message+2);  << tos := ReplyPortId;  >>          02601000
      tos := QM0array(x:=x+1);                                          02602000
      Send'Q( * ,QM0array(@Message +4),Message);                        02603000
      return;   << exit from DownSemaphore >>                           02604000
      end;                                                              02605000
    << must stay disabled thru enqueue'msg >>                           02606000
    CalcAbsQ;  << push absolute bank and address onto tos >>            02607000
    tos := tos + @Message;  << initializes AbsMessage >>                02608000
    << fall through into FillMsg >>                                     02609000
                                                                        02610000
<<>>                                                                    02611000
                                                                        02612000
FillMsg :                                                               02613000
                                                                        02614000
  << note that interrupts are still disabled >>                         02615000
  tos := AbsPortDB;     << move the data into the msg buffer >>         02616000
  tos := tos + @msg;                                                    02617000
  tos := AbsMessage;                                                    02618000
  tos := Length;                                                        02619000
  mabs5;  << perform an absolute move, and pop all parameters >>        02620000
  asmb( ddel );  << delete AbsMessage >>                                02621000
  goto enqueue'msg;                                                     02622000
                                                                        02623000
<<>>                                                                    02624000
                                                                        02625000
DownSemaphore'Ref :   << secondary entry point >>                       02626000
  if PortDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>       02627000
  Length := Message(1);  << +*+ >>                                      02628000
  if Length > PortDSTMaxMsgSize then  << +*+ >>                         02629000
    suddendeath(badportcall);  << +*+ >>                                02630000
                                                                        02631000
  disable;                                                              02632000
  SemaphoreCnt := SemaphoreCnt -1;                                      02633000
  if >= then                                                            02634000
    begin  << request granted immeadiatly >>                            02635000
    enable;                                                             02636000
    Send'Ref(DMessage(1),Message(4),Message);                           02637000
    return;   << exit from DownSemaphore >>                             02638000
    end;                                                                02639000
  turn'traps'off;                                                       02640000
  pdisable;                                                             02641000
  PUSH(DB);   << simulate exchangedb'to'portdst >>                      02642000
  asmb( ddup );  << NOTE: in this path, AbsMessage is NOT allocated! >> 02643000
  @msg := @Message;                                                     02644000
  << fall through into enqueue'msg >>                                   02645000
                                                                        02646000
<<>>                                                                    02647000
                                                                        02648000
enqueue'msg :                                                           02649000
 if Subqueue > PortDSTMaxSubqueue then suddendeath(badportcall);        02650000
                                                                        02651000
  << must queue the request for UpSemaphore >>                          02652000
  << note that interrupts are still disabled >>                         02653000
  msg := 0;  << break msg link into free pool >>                        02654000
  dbl'ptrs := PortCB'dbl(Subqueue + SubqueuesOffset);                   02655000
  if @qhead <> 0 then                                                   02656000
    begin  << not the first message >>                                  02657000
    @qtail := qtail := @msg;  << queue to tail >>                       02658000
    PortCB'dbl(x) := dbl'ptrs;                                          02659000
    end                                                                 02660000
  else                                                                  02661000
    begin  << first message in the queue >>                             02662000
    tos := tos := @msg;  << queue to the front >>                       02663000
    PortCB'dbl(x) := tos;                                               02664000
    set'message'bit;  << set flags to indicate a msg is present >>      02665000
    end;                                                                02666000
  enable;                                                               02667000
                                                                        02668000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02669000
  end;  << DownSemaphore >>                                             02670000
$page "Create'Semaphore'Port"                                           02671000
procedure Create'Semaphore'Port(PortDST, InitCount,                     02672000
                                PortId',  Result);                      02673000
  value                         PortDST, InitCount;                     02674000
  integer                       PortDST, InitCount, Result;             02675000
  double                        PortId';                                02676000
  option privileged,uncallable;                                         02677000
                                                                        02678000
  begin                                                                 02679000
  equate  badparm1 = 1,                                                 02680000
          splitstk = 10;                                                02681000
  double PortId;                                                        02682000
  logical pointer PortCB = PortId +1;                                   02683000
  integer pointer IntPortCB = PortCB;  << needed by SemaphoreCnt >>     02684000
                                                                        02685000
  integer pointer msg;                                                  02686000
                                                                        02687000
  PortId' := 0D;                                                        02688000
  CreatePort'(PortDST, 3, 0, 0, 3, PortId, Result);                     02689000
  if Result <> 0 then go to Exit;                                       02690000
  exchangedb(PortDST);                                                  02691000
  SemaphoreCnt := InitCount;                                            02692000
  PortCB'subtype := Semaphore'subtype;                                  02693000
  exchangedb(0);                                                        02694000
                                                                        02695000
 PortId' := PortId;                                                     02696000
Exit: end;                                                              02697000
                                                                        02698000
$page "FetchSeg"                                                        02699000
procedure FetchSeg(SegId,ReqType,ReplyPort,ReplySubqueue);              02700000
  value SegId,ReqType,ReplyPort,ReplySubqueue;                          02701000
  logical SegId,ReqType;                                                02702000
  double ReplyPort;                                                     02703000
  integer ReplySubqueue;                                                02704000
  option privileged,uncallable;                                         02705000
                                                                        02706000
  begin                                                                 02707000
  integer PortDST;  << dummy for exchangedb'to'PortDST >>               02708000
                                                                        02709000
  integer pointer msg;                                                  02710000
  double pointer msg'dbl = msg;                                         02711000
                                                                        02712000
  if ReqType <> %100000 then suddendeath(badportcall);  << +*+ >>       02713000
$IF  X5=OFF                                                             02714000
  iofreeze'(SegId);                                                     02715000
$IF  X5=ON                                                              02716000
  iofreeze'(double(SegId));                                             02717000
$IF                                                                     02718000
  if < then                                                             02719000
    begin   << absent, lets do it >>                                    02720000
    << Allocate a message frame in the system PortDST to >>             02721000
    << save the parameters to fetchseg until kernelc >>                 02722000
    << calls PortSeg'completor. >>                                      02723000
                                                                        02724000
    PortDST := MsgHarbTabDSTN;                                          02725000
    exchangedb'to'PortDST;                                              02726000
                                                                        02727000
    pdisable;   << force secondary pool >>                              02728000
    allocate'message'frame;                                             02729000
    penable;                                                            02730000
                                                                        02731000
    msg'dbl := 5D;                                                      02732000
    msg'dbl(1) := ReplyPort;                                            02733000
    msg(4) := ReplySubqueue;                                            02734000
    msg(5) := SegId;                                                    02735000
    exchangedb'back;                                                    02736000
                                                                        02737000
    << Now request mem. mgr. to make it present >>                      02738000
$IF  X5=OFF                                                             02739000
    fetchioseg(SegId,0,-@msg,%100000);  << iofreeze it >>               02740000
$IF  X5=ON                                                              02741000
  fetchioseg(double(SegId),0,-@msg,%100000);                            02742000
$IF                                                                     02743000
    if = then  << Its present now! >>                                   02744000
      begin   << oops, how did this happen? >>                          02745000
      PortSeg'completor(-@msg);                                         02746000
      end;                                                              02747000
    end                                                                 02748000
  else                                                                  02749000
    begin   << already present, send message now >>                     02750000
    pdisable;   << force secondary pool >>                              02751000
    tos := 3D;    << length >>                                          02752000
    tos := SegId;                                                       02753000
    Send'S(ReplyPort,ReplySubqueue,3);                                  02754000
    penable;                                                            02755000
    del;                                                                02756000
    end;                                                                02757000
                                                                        02758000
  end;   << FetchSeg >>                                                 02759000
$page "ReleaseSeg"                                                      02760000
procedure ReleaseSeg(SegId,ReqType);                                    02761000
  value SegId,ReqType;                                                  02762000
  logical SegId,ReqType;                                                02763000
  option privileged,uncallable;                                         02764000
  begin                                                                 02765000
                                                                        02766000
  if Reqtype <> %100000 then suddendeath(badportcall);  << +*+ >>       02767000
$IF  X5=OFF                                                             02768000
  iounfreeze'(SegId);                                                   02769000
$IF  X5=ON                                                              02770000
  iounfreeze'(double(SegId));                                           02771000
$IF                                                                     02772000
  if < then suddendeath(badportcall); << DST not frozen! >>             02773000
                                                                        02774000
  end;   << ReleaseSeg >>                                               02775000
$page "PortSeg'completor"                                               02776000
procedure PortSeg'completor(msg'id);                                    02777000
  value msg'id;                                                         02778000
  integer msg'id;                                                       02779000
  option privileged,uncallable;                                         02780000
  begin                                                                 02781000
comment  NOTE: this procedure is called by the MPE procedure            02782000
    "awakedevice" in kernelc.  It is therefore possible to be called    02783000
    on the ICS.                                                         02784000
  ;                                                                     02785000
                                                                        02786000
  integer pointer msg = msg'id;                                         02787000
  double pointer msg'dbl = msg;                                         02788000
  double ReplyPort;                                                     02789000
  integer ReplySubqueue,                                                02790000
          ReqId;                                                        02791000
  integer PortDST = ReplyPort;                                          02792000
                                                                        02793000
  msg'id := -msg'id;  << kept as negitive to distinguish from ioqp >>   02794000
  PortDST := MsgHarbTabDSTN;                                            02795000
  exchangedb'to'PortDST;                                                02796000
                                                                        02797000
  << A message frame was allocated in the system PortDST to >>          02798000
  << save the parameters to fetchseg until kernelc >>                   02799000
  << calls PortSeg'completor. Get those parameters now. >>              02800000
                                                                        02801000
  ReplyPort := msg'dbl(1);                                              02802000
  ReplySubqueue := msg(4);                                              02803000
  ReqId := msg(5);                                                      02804000
                                                                        02805000
  << NOTE: this is basically the same code as the global define >>      02806000
  << "exchangedb'to'PortDST".  The major difference is that if >>       02807000
  << the PortDST is absent, we will switch to the system port >>        02808000
  << server process to handle the absence trap.  This and >>            02809000
  << PortTimeOut are the only instances where a PortDST may >>          02810000
  << be absent when trying to access it from the ICS. >>                02811000
                                                                        02812000
  tos := %344;  << DST 71 >>  << +*+ >>                                 02813000
  tos := abs(abs(2))&lsl(2);  << Max DST from DST(0) >> << +*+ >>       02814000
  x := PortDST&LSL(2);                                                  02815000
  if not (tos <= x <= tos) then suddendeath(wrongDST);  << +*+ >>       02816000
  disable;                                                              02817000
  x := dst(x);  << set cond. code >>                                    02818000
  if < then                                                             02819000
    begin  << absent! >>                                                02820000
    on'ics;  << tos = true if executing on the ics >>                   02821000
    if tos then                                                         02822000
      begin << on the ICS, or called pdisabled >>                       02823000
      << switch to system port server, where absence trap ok >>         02824000
      enable;                                                           02825000
      tos := 3D;   << Length >>                                         02826000
      tos := -msg'id;                                                   02827000
      << Uses secondary pool since pdisabled >>                         02828000
      Send'S(FindProcessPort(SysPort'pin),1,3);                         02829000
      asmb( ddel,del );                                                 02830000
      exchangedb'back;   << from MsgHarbTabDSTN  >>                     02831000
      return;   << exit from PortSeg'completor >>                       02832000
      end;                                                              02833000
    end;                                                                02834000
  enable;                                                               02835000
                                                                        02836000
  release'message'frame;                                                02837000
  exchangedb'back;                                                      02838000
                                                                        02839000
  tos := 3D;  << length >>                                              02840000
  tos := ReqId;                                                         02841000
  Send'S(ReplyPort,ReplySubqueue,3);                                    02842000
  del;                                                                  02843000
                                                                        02844000
  end;  << PortSeg'completor >>                                         02845000
$page "StartTimer"                                                      02846000
double procedure StartTimer(DeltaTime,ReplyPort,ReplySubqueue,          02847000
                              ReqId);                                   02848000
  value DeltaTime,ReplyPort,ReplySubqueue,ReqId;                        02849000
  double DeltaTime,ReplyPort;                                           02850000
  integer ReplySubqueue,ReqId;                                          02851000
  option privileged,uncallable;                                         02852000
                                                                        02853000
  begin                                                                 02854000
  double PortId = ReplyPort, CurrentTime;                               02855000
  double TimerId = StartTimer, rollover := 2073600000D;                 02856000
  integer TimerDST = TimerId;                                           02857000
  integer pointer TimerCB = TimerId +1;                                 02858000
  double pointer TimerCB'dbl = TimerCB;                                 02859000
  integer pointer msg = TimerCB;  << for allocate'message'frame >>      02860000
                                                                        02861000
  integer pointer prev,                                                 02862000
                  next;                                                 02863000
  double pointer prev'dbl = prev,                                       02864000
                 next'dbl = next;                                       02865000
  define next'abstime = next'dbl(abstime'index)#;                       02866000
  integer oldhead;                                                      02867000
                                                                        02868000
  std'decl;                                                             02869000
double subroutine to'delta(abstime);                                    02870000
  value abstime;                                                        02871000
  double abstime;                                                       02872000
  begin                                                                 02873000
    TOS := abstime - CurrentTime;                                       02874000
    if < then TOS := TOS + rollover;                                    02875000
    asmb(STD S-6);                                                      02876000
  end;                                                                  02877000
  turn'traps'off;                                                       02878000
  CurrentTime := Timer;                                                 02879000
                                                                        02880000
  if DeltaTime <= 0D then suddendeath(badportcall);  << +*+ >>          02881000
  << round DeltaTime up to 100ms Tick interval >>                       02882000
  tos := DeltaTime;                                                     02883000
  tos := 100D;                                                          02884000
  asmb( ddiv );                                                         02885000
  asmb( dtst,ddel );  << delete remainder >>                            02886000
  if <> then                                                            02887000
    tos := tos + 1D;                                                    02888000
  tos := 100D;                                                          02889000
  asmb( dmul );                                                         02890000
  DeltaTime := tos;                                                     02891000
  CurrentTime := Timer;                                                 02892000
                                                                        02893000
  TimerDST := PortDST;                                                  02894000
  exchangedb'to'PortDST;  << DB to ReplyPortDST >>                      02895000
  if PortDSTMaxMsgSize < TimerLength then  << +*+ >>                    02896000
    suddendeath(badportcall);  << +*+ >>                                02897000
                                                                        02898000
  allocate'message'frame;  << sets TimerCB via msg >>                   02899000
  if @msg = 0 then suddendeath(badport);  << ICS only >>                02900000
                                                                        02901000
  TimerCB'length := TimerLength;                                        02902000
  TimerCB'reqid := ReqId;                                               02903000
  TimerCB'replyport := ReplyPort;                                       02904000
  TimerCB'subqueue := ReplySubqueue;                                    02905000
                                                                        02906000
  << insert element in time order >>                                    02907000
  disable;  << needed because of ICS ports >>                           02908000
  oldhead := TimeHead;                                                  02909000
  @prev := @TimeHead;                                                   02910000
  @next := TimeHead;                                                    02911000
  while <> and to'delta(next'abstime) <= DeltaTime do                   02912000
    begin  << find place in list >>                                     02913000
                                                                        02914000
    @prev := @next;                                                     02915000
    @next := next;                                                      02916000
    end;                                                                02917000
  << insert it >>                                                       02918000
  TimerCB := @next;  << link new to rest of list >>                     02919000
  prev := @TimerCB;                                                     02920000
  TimerCB'abstime := CurrentTime + DeltaTime;                           02921000
  if < or TimerCB'abstime > rollover then                               02922000
          TimerCB'abstime := TimerCB'abstime - rollover;                02923000
                                                                        02924000
  if oldhead <> TimeHead then                                           02925000
    begin  << new head entry, start a new MPE timer >>                  02926000
    if TimeTRLX <> 0 then aborttimereq(TimeTRLX);                       02927000
                                                                        02928000
    TimeTRLX := timereq(%13,TimerDST,deltatime);                        02929000
    end;                                                                02930000
  enable;                                                               02931000
                                                                        02932000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 02933000
  end;   << StartTimer >>                                               02934000
$page "AbortTimer"                                                      02935000
procedure AbortTimer(TimerId);                                          02936000
  value TimerId;                                                        02937000
  double TimerId;                                                       02938000
  option privileged,uncallable;                                         02939000
                                                                        02940000
  begin                                                                 02941000
  integer TimerDST = TimerId;                                           02942000
  integer pointer TimerCB = TimerId +1;                                 02943000
  double pointer TimerCB'dbl = TimerCB;                                 02944000
  integer pointer msg = TimerCB;  << for release'message'frame >>       02945000
                                                                        02946000
  integer Subqueue;                                                     02947000
  integer pointer prev,                                                 02948000
                  next;                                                 02949000
  double pointer prev'dbl = prev,                                       02950000
                 next'dbl = next;                                       02951000
  define next'abstime = next'dbl(abstime'index)#;                       02952000
  integer oldhead;   << data is of pointer type >>                      02953000
                                                                        02954000
  double PortId, CurrentTime, rollover := 2073600000D;                  02955000
  std'decl;                                                             02956000
  std'decl2;                                                            02957000
double subroutine to'delta(abstime);                                    02958000
  value abstime;                                                        02959000
  double abstime;                                                       02960000
  begin                                                                 02961000
    TOS := abstime - CurrentTime;                                       02962000
    if < then TOS := TOS + rollover;                                    02963000
    asmb(STD S-6);                                                      02964000
  end;                                                                  02965000
turn'traps'off;                                                         02966000
                                                                        02967000
  CurrentTime := Timer;                                                 02968000
  PortDST := TimerDST;                                                  02969000
  exchangedb'to'PortDST;  << DB to TimerDST >>                          02970000
                                                                        02971000
  disable;  << needed because of ICS ports >>                           02972000
  if TimerCB'length = TimerLength then                                  02973000
    begin   << timer hasn't popped, remove from timer list >>           02974000
    oldhead := TimeHead;                                                02975000
    if = then suddendeath(badport);  << +*+ >>                          02976000
    @prev := @TimeHead;                                                 02977000
    while prev <> @TimerCB do                                           02978000
      begin  << find request in list >>                                 02979000
      @prev := prev;                                                    02980000
      if = then suddendeath(badport);  << +*+ >>                        02981000
      end;                                                              02982000
    prev := TimerCB;   << delink request >>                             02983000
    if oldhead <> TimeHead then                                         02984000
      begin  << new head entry, restart MPE timer >>                    02985000
      aborttimereq(TimeTRLX);                                           02986000
      @next := TimeHead;                                                02987000
      TimeTRLX := if = then 0  << no more timers >>                     02988000
        else timereq(%13,TimerDST,to'delta(next'abstime));              02989000
      end;                                                              02990000
    end                                                                 02991000
  else                                                                  02992000
    begin  << already popped, queued to a port >>                       02993000
    if TimerCB'length <> TimerPoppedLen then  << +*+ >>                 02994000
      suddendeath(badport);  << +*+ >>                                  02995000
    PortId := TimerCB'replyport;                                        02996000
    if PortDST <> PortDSTnum then suddendeath(badport);  << +*+ >>      02997000
                                                                        02998000
    Subqueue := TimerCB'subqueue;                                       02999000
    dbl'ptrs := PortCB'dbl(Subqueue + Subqueuesoffset);                 03000000
    @next := @prev := @qhead;                                           03001000
    if = then suddendeath(badport);  << +*+ >>                          03002000
    while @next <> @TimerCB do                                          03003000
      begin  << find request in list >>                                 03004000
      @prev := @next;                                                   03005000
      @next := next;                                                    03006000
      if = then suddendeath(badport);  << +*+ >>                        03007000
      end;                                                              03008000
    << delink found entry >>                                            03009000
    if @prev <> @next                                                   03010000
      then prev := next   << not at head of queue >>                    03011000
      else @prev := @qhead := next;  << remove head entry >>            03012000
    if @qtail = @next then                                              03013000
      @qtail := @prev;  << removed last in list >>                      03014000
    PortCB'dbl(Subqueue + Subqueuesoffset) := dbl'ptrs;                 03015000
    if @qhead = 0 then                                                  03016000
      reset'message'bit;                                                03017000
    end;                                                                03018000
  enable;                                                               03019000
                                                                        03020000
  TimerCB'length := 2;  << convert to null message >>                   03021000
  release'message'frame;                                                03022000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03023000
  end;   << AbortTimer >>                                               03024000
$page "PortTimeOut"                                                     03025000
procedure PortTimeOut(TimerDST);                                        03026000
  value TimerDST;                                                       03027000
  integer TimerDST;                                                     03028000
  option privileged,uncallable;                                         03029000
  begin                                                                 03030000
comment  NOTE: this procedure is called by the MPE procedure            03031000
    "oldtick" in hardres.  It is therefore callable on the              03032000
    ICS.                                                                03033000
  ;                                                                     03034000
                                                                        03035000
  integer pointer TimerCB;                                              03036000
  double pointer TimerCB'dbl = TimerCB;                                 03037000
  double pointer TimeHead'dbl = TimeHead;                               03038000
  define Head'AbsTime = TimeHead'dbl(abstime'index)#;                   03039000
                                                                        03040000
  double PortId, ThisTime, CurrentTime, rollover := 2073600000D;        03041000
  integer Subqueue;                                                     03042000
double subroutine to'delta(abstime);                                    03043000
  value abstime;                                                        03044000
  double abstime;                                                       03045000
  begin                                                                 03046000
    TOS := abstime - CurrentTime;                                       03047000
    if < then TOS := TOS + rollover;                                    03048000
    asmb(STD S-6);                                                      03049000
  end;                                                                  03050000
                                                                        03051000
  << NOTE: this is basically the same code as the global define >>      03052000
  << "exchangedb'to'PortDST".  The major difference is that if >>       03053000
  << the PortDST is absent, we will switch to the system port >>        03054000
  << server process to handle the absence trap.  This and >>            03055000
  << PortSeg'completor are the only instances where a PortDST may >>    03056000
  << be absent when trying to access it from the ICS. >>                03057000
                                                                        03058000
  tos := %344;  << DST 71 >>  << +*+ >>                                 03059000
  tos := abs(abs(2))&lsl(2);  << Max DST from DST(0) >> << +*+ >>       03060000
  x := TimerDST&LSL(2);                                                 03061000
  if not (tos <= x <= tos) then suddendeath(wrongDST);  << +*+ >>       03062000
  disable;                                                              03063000
  tos := dst(x);                                                        03064000
  if < then                                                             03065000
    begin  << absent! >>                                                03066000
    pdisable;  << on'ics needs at least on pdisable in effect >>        03067000
    on'ics;  << tos = true if executing on the ics >>                   03068000
    if tos then                                                         03069000
      begin << on the ICS, or called pdisabled >>                       03070000
      << switch to system port server, where absence trap ok >>         03071000
      enable;                                                           03072000
      tos := 3D;   << Length >>                                         03073000
      tos := TimerDST;                                                  03074000
      << Uses secondary pool since pdisabled >>                         03075000
      Send'S(FindProcessPort(SysPort'pin),2,3);                         03076000
   << asmb( ddel,ddel ); >>  << msg plus dst(0) >>                      03077000
      penable;                                                          03078000
      return;   << exit from PortTimeOut >>                             03079000
      end                                                               03080000
    else                                                                03081000
      begin  << absent, and ok to cause a makepresent >>                03082000
      penable;                                                          03083000
      x := TimerDST&LSL(2);   << on'ics alters X reg. >>                03084000
      do begin                                                          03085000
        del;                                                            03086000
$IF  X5=OFF                                                             03087000
        queueonsegment(TimerDST.(2:14));                                03088000
$IF  X5=ON                                                              03089000
        queueonsegment(double(TimerDST.(2:14)));                        03090000
$IF                                                                     03091000
        tos := dst(x);                                                  03092000
      end until > ;                                                     03093000
      end;  << DST now present >>                                       03094000
    end;  << absent case >>                                             03095000
  tos.(2:1) := true;  << set ref. bit >>                                03096000
  dst(x) := tos;                                                        03097000
  pdisable;                                                             03098000
  << stay inturrupt disabled, until Tick loop >>                        03099000
                                                                        03100000
  turn'traps'off;                                                       03101000
  CurrentTime := Timer;                                                 03102000
  tos := dst(x:=x+2);  << bank >>                                       03103000
  tos := dst(x:=x+1);  << addr >>                                       03104000
  asmb( ddup );                                                         03105000
  asmb( xchd );                                                         03106000
  if TimerDST <> PortDSTnum then suddendeath(wrongDST);  << +*+ >>      03107000
                                                                        03108000
  aborttimereq(TimeTRLX);                                               03109000
  TimeTRLX := 0;                                                        03110000
                                                                        03111000
  @TimerCB := TimeHead;                                                 03112000
  ThisTime := Head'abstime;                                             03113000
  do begin  << process all Ticks = present time >>                      03114000
    @TimerCB := TimeHead;                                               03115000
    TimeHead := TimerCB;  << delink entry >>                            03116000
    enable;                                                             03117000
    PortId := TimerCB'replyport;                                        03118000
    Subqueue := TimerCB'subqueue;                                       03119000
    TimerCB'length := TimerPoppedLen;  << hide ReplyPort & Subqueue>>   03120000
    Send'Ref(PortId,Subqueue,TimerCB);                                  03121000
    disable;                                                            03122000
  end until TimeHead = 0 or Head'absTime <> thistime;                   03123000
                                                                        03124000
  if TimeHead <> 0 then                                                 03125000
    begin                                                               03126000
    TimeTRLX := timereq(%13,TimerDST,to'delta(Head'abstime));           03127000
    end;                                                                03128000
  enable;                                                               03129000
                                                                        03130000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03131000
  end;   << PortTimeOut >>                                              03132000
$page "Create'Signal'Port"                                              03133000
procedure SignalPort'server(PortId,Context,Message);                    03134000
  value PortId,Context,Message;                                         03135000
  double PortId;                                                        03136000
  integer pointer Context,Message;                                      03137000
  option privileged,uncallable,internal;                                03138000
  begin                                                                 03139000
  logical pointer PortCB = PortId +1;                                   03140000
  double pointer PortCB'dbl = PortCB;                                   03141000
  double pointer dblcontext = context;                                  03142000
  integer Subqueue;                                                     03143000
                                                                        03144000
  Subqueue := Message << (0) >>;                                        03145000
  << the following should probably be replaced >>                       03146000
  PortDisable(PortId);                                                  03147000
  Replace'Ref(PortId,Subqueue,Message);                                 03148000
  PortMaskEnable(PortId,1&csr(Subqueue +1));  << Re-enable mask >>      03149000
                                                                        03150000
  tos := 4D;  << Subqueue and Length >>                                 03151000
  tos := PortId;   << PortId must be sent, indicating data avail. >>    03152000
  Send'S(homeport, homesubqueue, 4);                                    03153000
                                                                        03154000
  end;                                                                  03155000
                                                                        03156000
procedure Create'Signal'Port( PortDST, DestPortId,                      03157000
                              DestSubqueue, PortId', Result);           03158000
  value    PortDST, DestPortId, DestSubqueue;                           03159000
  integer  PortDST, DestSubqueue, Result;                               03160000
  double   DestPortId, PortId';                                         03161000
  option privileged,uncallable;                                         03162000
                                                                        03163000
  begin                                                                 03164000
  equate badparm1 = 1,                                                  03165000
         splitstk = 10;                                                 03166000
  double PortId;                                                        03167000
  logical pointer PortCB = PortId +1, context;                          03168000
  double pointer PortCB'dbl = PortCB, dblcontext = context;             03169000
                                                                        03170000
  integer pointer msg;                                                  03171000
                                                                        03172000
  PortId' := 0D;                                                        03173000
  CreatePort'(PortDST, 3, @SignalPort'server, 0, 3, PortId, Result);    03174000
  if Result <> 0 then go to Exit;                                       03175000
  exchangedb(PortDST);                                                  03176000
  << Initialize the PortCB home port area >>                            03177000
  @context := PortCB'context;                                           03178000
  homeport := DestPortId;                                               03179000
  homesubqueue := DestSubqueue;                                         03180000
  exchangedb(0);                                                        03181000
  PortId' := PortId;                                                    03182000
                                                                        03183000
Exit:  end;   << Create'Signal'Port >>                                  03184000
$page "IOWait Ports - EnableIOWaitPort"                                 03185000
procedure EnableIOWaitPort(IOWait'Index);                               03186000
  value IOWait'Index;                                                   03187000
  integer IOWait'Index;                                                 03188000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 03189000
  begin                                                                 03190000
                                                                        03191000
  double PortId;                                                        03192000
  integer pointer Context;                                              03193000
  std'decl;                                                             03194000
                                                                        03195000
  equate user'interrupt = 0,                                            03196000
         file'soft'int = 1,                                             03197000
         awaken'process = 0;                                            03198000
                                                                        03199000
  << DB must be at stack DB >>                                          03200000
  tos := @PortId;  << find PortId in IOWaitDST >>                       03201000
  tos := IOWait'PortId'DST;                                             03202000
  tos := IOWait'Index;                                                  03203000
  tos := 2;   << PortId is a double word >>                             03204000
  asmb( mfds 4 );                                                       03205000
                                                                        03206000
  exchangedb'to'PortDST;                                                03207000
  @Context := PortCb'context;                                           03208000
                                                                        03209000
  disable;                                                              03210000
  PortCB'enabled := true;                                               03211000
  tos := PortCB'dbl;   << get both flags and mask >>                    03212000
  asmb( and,del );                                                      03213000
  if <> and not PortCB'active <<and PortCB'enabled>> then               03214000
    begin  << simulate running the port procedure >>                    03215000
    tos := @IOWaitPort'server;  << load required Plabel >>              03216000
    if tos <> PortCB'server'plabel then                                 03217000
      suddendeath(badport);                                             03218000
                                                                        03219000
    << This code is essentially duplicated from PortDispatcher >>       03220000
    << and IOWaitPort'server procedures for performance reasons >>      03221000
    PortCB'active := true;                                              03222000
    enable;                                                             03223000
                                                                        03224000
    if IOWait'softint'plabel = 0 then                                   03225000
      awake(integer(PortCB'pin)*pcbsize,msgwaitcode,nowait)             03226000
    else                                                                03227000
      begin  << must invoke use's soft interrupt routine >>             03228000
      tos := IOWait'aftioqx;   << used for dump analysis only >>        03229000
      tos := IOWait'aftindex;                                           03230000
      causesoftint(PortCB'pin,user'interrupt,file'soft'int,             03231000
                     IOWait'softint'plabel,2,awaken'process);           03232000
      end;                                                              03233000
    disable;                                                            03234000
    PortCB'active := false;                                             03235000
    PortCB'enabled := false;                                            03236000
    end;                                                                03237000
                                                                        03238000
  tos := PortCb'dbl;   << get both flags and mask >>                    03239000
  enable;                                                               03240000
  asmb( and,del );                                                      03241000
  if <>                                                                 03242000
    then cc := ccl                                                      03243000
    else cc := cce;                                                     03244000
                                                                        03245000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03246000
                                                                        03247000
  end;   << EnableIOWaitPort >>                                         03248000
$page "IOWait Ports - DisableIOWaitPort"                                03249000
procedure DisableIOWaitPort(IOWait'Index);                              03250000
  value IOWait'Index;                                                   03251000
  integer IOWait'Index;                                                 03252000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 03253000
  begin                                                                 03254000
                                                                        03255000
  double PortId;                                                        03256000
  std'decl;                                                             03257000
                                                                        03258000
  << DB must be at stack DB >>                                          03259000
  tos := @PortId;  << find PortId in IOWaitDST >>                       03260000
  tos := IOWait'PortId'DST;                                             03261000
  tos := IOWait'Index;                                                  03262000
  tos := 2;   << PortId is a double word >>                             03263000
  asmb( mfds 4 );                                                       03264000
                                                                        03265000
  exchangedb'to'PortDST;                                                03266000
                                                                        03267000
  disable;                                                              03268000
  PortCB'enabled := false;                                              03269000
  tos := PortCB'dbl;   << get both flags and mask >>                    03270000
  enable;                                                               03271000
  asmb( and,del );                                                      03272000
  if <>                                                                 03273000
    then cc := ccl                                                      03274000
    else cc := cce;                                                     03275000
                                                                        03276000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03277000
                                                                        03278000
  end;   << DisableIOWaitPort >>                                        03279000
$page "IOWait Ports - IOWaitDispatcher"                                 03280000
procedure IOWaitDispatcher(IOWait'Index);                               03281000
  value IOWait'Index;                                                   03282000
  integer IOWait'Index;                                                 03283000
  option privileged,uncallable;  << NOT internal, but NOT in SPLINTR >> 03284000
  begin                                                                 03285000
                                                                        03286000
  double PortId;                                                        03287000
  integer pointer Message,                                              03288000
                  msg;                                                  03289000
  integer pointer Context,                                              03290000
                  aft;                                                  03291000
  integer ioqx,                                                         03292000
          fnum,   << aft index >>                                       03293000
          dl,     << DL Register value >>                               03294000
          NewCount;                                                     03295000
  logical pmap;                                                         03296000
  integer move'target;  << need local copies of IOWAIT's ref. parms >>  03297000
                                                                        03298000
  integer Old'DST,                                                      03299000
          Subqueue,                                                     03300000
          msg'size,                                                     03301000
          context'ptr,                                                  03302000
          context'size;                                                 03303000
  integer S0 = S-0,                                                     03304000
          S1 = S-1;                                                     03305000
  integer pointer PS0 = S-0;                                            03306000
                                                                        03307000
  integer deltaQ = Q-0;                                                 03308000
  integer array QM0(*) = Q-0;                                           03309000
  equate Q'status = -1;  << status reg. in stack marker >>              03310000
  integer pointer iowait'stackmarker;                                   03311000
  equate iowait'funcvalue = -9,   << IOWAIT parameters >>               03312000
         iowait'fnum = -8,                                              03313000
         iowait'target = -7,                                            03314000
         iowait'tcount = -6,                                            03315000
         iowait'cstation = -5,                                          03316000
         iowait'pmap = -4;                                              03317000
                                                                        03318000
  std'decl2;   << qhead/qtail >>                                        03319000
  std'decl;                                                             03320000
                                                                        03321000
  Old'DST := exchangedb(0);                                             03322000
  tos := @PortId;  << find PortId in IOWaitDST >>                       03323000
  tos := IOWait'PortId'DST;                                             03324000
  tos := IOWait'Index;                                                  03325000
  if < then tos := -tos;   << soft int. loads -Index >>                 03326000
  tos := 2;   << PortId is a double word >>                             03327000
  asmb( mfds 4 );                                                       03328000
                                                                        03329000
  exchangedb'to'PortDST;                                                03330000
                                                                        03331000
  disable;                                                              03332000
  PortCB'active := true;  << mutual exclusion semaphore >>              03333000
  dequeue'hipri'message;                                                03334000
  enable;                                                               03335000
  msg'size := msg(msg'length);                                          03336000
  context'ptr := PortCB'context;                                        03337000
  context'size := PortDSTMaxContextSize;                                03338000
                                                                        03339000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03340000
                                                                        03341000
  << make room for data structures on the stack >>                      03342000
  @Message := @S0 +1;                                                   03343000
  tos := msg'size;                                                      03344000
  asmb( adds 0 );  << allocate space for messages >>                    03345000
                                                                        03346000
  tos := @Message;   << copy message frame to stack >>                  03347000
  tos := PortDST;                                                       03348000
  tos := @msg;                                                          03349000
  tos := msg'size;                                                      03350000
  asmb( mfds 4 );                                                       03351000
                                                                        03352000
  << copy the context area to the stack >>                              03353000
  @Context := @S0 +1;                                                   03354000
  tos := context'size;                                                  03355000
  asmb( adds 0 );  << allocate space for context area >>                03356000
                                                                        03357000
  tos := @Context;  << move context to stack >>                         03358000
  tos := PortDST;                                                       03359000
  tos := context'ptr;                                                   03360000
  tos := context'size;                                                  03361000
  asmb( mfds 4 );                                                       03362000
                                                                        03363000
  << make copies of IOWAIT's parameters >>                              03364000
  @iowait'stackmarker := @QM0(-deltaQ);                                 03365000
  pmap := iowait'stackmarker(iowait'pmap);                              03366000
                                                                        03367000
  tos := @iowait'stackmarker(iowait'funcvalue);  << upper bounds >>     03368000
  tos := iowait'stackmarker(iowait'fnum);                               03369000
  tos := Old'DST;                                                       03370000
  if not pmap.(13:1)                                                    03371000
    then tos := 0D   << target not specified >>                         03372000
    else                                                                03373000
      begin  << target specified, specify bounds >>                     03374000
      tos := iowait'stackmarker(iowait'target);                         03375000
      if Old'DST = 0 then                                               03376000
        begin  << stack DB, use IOWAIT marker as limit >>               03377000
        tos := @iowait'stackmarker(iowait'funcvalue) - S0;              03378000
        end                                                             03379000
      else                                                              03380000
        begin  << DB at an XDS, use DST length as limit >>              03381000
        tos := DST'Size(Old'DST);                                       03382000
        end;                                                            03383000
      end;                                                              03384000
  if not pmap.(14:1) then tos := 0  << tcount not specified >>          03385000
  else if Old'DST = 0 then                                              03386000
    begin  << easy, user called IOWAIT with DB at stack >>              03387000
    tos := iowait'stackmarker(iowait'tcount);                           03388000
    tos := PS0;                                                         03389000
    asmb( delb );                                                       03390000
    end                                                                 03391000
  else                                                                  03392000
    begin  << a little harder, user called with DB at an XDS >>         03393000
    tos := @move'target;                                                03394000
    tos := Old'DST;                                                     03395000
    tos := iowait'stackmarker(iowait'tcount);                           03396000
    tos := 1;  << move count >>                                         03397000
    asmb( mfds 4 );                                                     03398000
                                                                        03399000
    tos := move'target;  << tcount >>                                   03400000
    end;                                                                03401000
                                                                        03402000
  if not pmap.(15:1) then tos := 0  << cstation not specified >>        03403000
  else if Old'DST = 0 then                                              03404000
    begin  << easy, user called IOWAIT with DB at stack >>              03405000
    tos := iowait'stackmarker(iowait'cstation);                         03406000
    tos := PS0;                                                         03407000
    asmb( delb );                                                       03408000
    end                                                                 03409000
  else                                                                  03410000
    begin  << a little harder, user called with DB at an XDS >>         03411000
    tos := @move'target;                                                03412000
    tos := Old'DST;                                                     03413000
    tos := iowait'stackmarker(iowait'cstation);                         03414000
    tos := 1;  << move count >>                                         03415000
    asmb( mfds 4 );                                                     03416000
                                                                        03417000
    tos := move'target;  << cstation >>                                 03418000
    end;                                                                03419000
                                                                        03420000
  tos := 2;   << CondCode >>                                            03421000
  tos := pmap;                                                          03422000
                                                                        03423000
  << actually run the server here >>                                    03424000
  tos := PortId;                                                        03425000
  tos := @Context + IOWait'usercontext;                                 03426000
  tos := @Message;                                                      03427000
  tos := IOWait'portplabel;                                             03428000
  asmb( pcal 0 );                                                       03429000
                                                                        03430000
  del;    << delete pmap >>                                             03431000
  iowait'stackmarker(Q'status).(6:2) := tos;  << "return" CondCode >>   03432000
  if not pmap.(15:1) then                                               03433000
    asmb(del)        << delete zero for cstation >>                     03434000
  else               << cstation specified       >>                     03435000
    if Old'DST = 0 then                                                 03436000
      begin  << easy, user called IOWAIT with DB at stack >>            03437000
      tos := iowait'stackmarker(iowait'cstation);                       03438000
      PS0 := S1;                                                        03439000
      ddel;  << addr. and cstation >>                                   03440000
      end                                                               03441000
    else                                                                03442000
      begin  << a little harder, user called with DB at an XDS >>       03443000
      move'target := tos;   << cstation >>                              03444000
      tos := Old'DST;                                                   03445000
      tos := iowait'stackmarker(iowait'cstation);                       03446000
      tos := @move'target;                                              03447000
      tos := 1;  << move count >>                                       03448000
      asmb( mtds 4 );                                                   03449000
      end;                                                              03450000
                                                                        03451000
  if not pmap.(14:1) then                                               03452000
    asmb(del)        << delete zero for tcount   >>                     03453000
  else               << tcount specified         >>                     03454000
    if Old'DST = 0 then                                                 03455000
      begin  << easy, user called IOWAIT with DB at stack >>            03456000
      tos := iowait'stackmarker(iowait'tcount);                         03457000
      PS0 := S1;                                                        03458000
      ddel;  << addr. and tcount >>                                     03459000
      end                                                               03460000
    else                                                                03461000
      begin  << a little harder, user called with DB at an XDS >>       03462000
      move'target := tos;   << tcount >>                                03463000
      tos := Old'DST;                                                   03464000
      tos := iowait'stackmarker(iowait'tcount);                         03465000
      tos := @move'target;                                              03466000
      tos := 1;  << move count >>                                       03467000
      asmb( mtds 4 );                                                   03468000
      end;                                                              03469000
                                                                        03470000
  asmb( subs 5 );  << delete MaxLength, BuffOffset, BuffDST, >>         03471000
                   << AFTIndex, and StackUpperBounds from TOS >>        03472000
                                                                        03473000
  << put the copy of the context back in the PortDST >>                 03474000
  tos := PortDST;                                                       03475000
  tos := context'ptr + IOWait'usercontext;                              03476000
  tos := @Context + IOWait'usercontext;                                 03477000
  tos := context'size - IOWait'usercontext;                             03478000
  asmb( mtds 4 );                                                       03479000
                                                                        03480000
  exchangedb'to'PortDST;                                                03481000
  release'message'frame;                                                03482000
                                                                        03483000
  @Context := context'ptr;                                              03484000
  fnum := IOWait'aftindex;                                              03485000
  ioqx := if IOWait'softint'plabel <> 0                                 03486000
            then softintpend                                            03487000
            else IOWait'aftioqx;                                        03488000
  disable;                                                              03489000
  PortCB'active := false;  << mutual exclusion no longer needed >>      03490000
  IOWait'count := IOWait'count -1;                                      03491000
  enable;                                                               03492000
  NewCount := IOWait'count;                                             03493000
  << Note: IOWait port procedures may NOT call TerminatePort >>         03494000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03495000
                                                                        03496000
  if NewCount > 0 then                                                  03497000
    begin  << set ioqx into aft for IOWAITs use >>                      03498000
    push(dl);  dl := tos;                                               03499000
    @aft := -fnum*aftsize + dl - aft'base;                              03500000
    aft(to'ioqx) := ioqx;                                               03501000
    if ioqx = softintpend then PortEnable(PortId);                      03502000
    end;                                                                03503000
                                                                        03504000
  if Old'DST <> 0 then exchangedb(Old'DST);                             03505000
                                                                        03506000
  end;  << IOWaitDispatcher >>                                          03507000
$page "IOWait Ports - IOWaitPort'server"                                03508000
                                                                        03509000
procedure IOWaitPort'server(PortId,Context,Message);                    03510000
  value PortId,Context,Message;                                         03511000
  double PortId;                                                        03512000
  integer pointer Context,Message;                                      03513000
  option privileged,uncallable,internal;                                03514000
  begin                                                                 03515000
  logical pointer PortCB = PortId +1;                                   03516000
  double pointer PortCB'dbl = PortCB;                                   03517000
  integer Subqueue;                                                     03518000
                                                                        03519000
  equate user'interrupt = 0,                                            03520000
         port'soft'int = 2,                                             03521000
         awaken'process = 0;                                            03522000
                                                                        03523000
  << NOTE: IOWAIT software interrupts share code with message >>        03524000
  << files in "PSEUDOINT".  PseudoInt calls "FCPREPAFT" to >>           03525000
  << set the completion status of -1 in the AFT. >>                     03526000
                                                                        03527000
  Subqueue := Message << (0) >>;                                        03528000
  << the following should probably be replaced >>                       03529000
  PortDisable(PortId);                                                  03530000
  Replace'Ref(PortId,Subqueue,Message);                                 03531000
  PortMaskEnable(PortId,1&csr(Subqueue +1));  << Re-enable mask >>      03532000
                                                                        03533000
  if IOWait'softint'plabel = 0 then                                     03534000
    awake(integer(PortCB'pin)*pcbsize,msgwaitcode,nowait)               03535000
  else                                                                  03536000
    begin  << must invoke use's soft interrupt routine >>               03537000
    tos := IOWait'aftioqx;   << pseudoint stores into aft >>            03538000
    tos := IOWait'aftindex;                                             03539000
    causesoftint(PortCB'pin,user'interrupt,port'soft'int,               03540000
                   IOWait'softint'plabel,2,awaken'process);             03541000
    end;                                                                03542000
  end;  << IOWaitPort'server >>                                         03543000
$page "IOWait Ports - CreateIOWaitPort"                                 03544000
double procedure CreateIOWaitPort(ClassName,PortDST,NewFrames);         03545000
  value ClassName,PortDST,NewFrames;                                    03546000
  byte pointer ClassName;                                               03547000
  integer PortDST,NewFrames;                                            03548000
  option privileged,uncallable;                                         03549000
  begin                                                                 03550000
  double PortId = CreateIOWaitPort;                                     03551000
  logical pointer PortCB = PortId +1;                                   03552000
  double pointer PortCB'dbl = PortCB;                                   03553000
                                                                        03554000
  integer aftioqx;                                                      03555000
  integer pointer msg,                                                  03556000
                  Context;                                              03557000
                                                                        03558000
  integer Result;                                                       03559000
  array Name(0:7);  << massaged ClassName >>                            03560000
  integer array DictData(0:7) = Q;                                      03561000
  integer DictPlabel = DictData +0,                                     03562000
          DictType   = DictData +1,                                     03563000
          DictContext= DictData +2,                                     03564000
          DictMsgSize= DictData +3,                                     03565000
          DictNumSubqueues = DictData +4;                               03566000
                                                                        03567000
  CreateIOWaitPort := 0D;                                               03568000
  GenerateDictName(ClassName,Name);                                     03569000
                                                                        03570000
  DictFind(Name,DictData,Result);                                       03571000
  if Result <> 0 then return;                                           03572000
                                                                        03573000
  Create'IOWaitPort(PortDST, DictPlabel, DictNumSubqueues,              03574000
                    DictContext, PortId, Result);                       03575000
                                                                        03576000
  end;   << CreateIOWaitPort >>                                         03577000
procedure Create'IOWaitPort(PortDST, Plabel, NumSubques, ContextSize,   03578000
                            PortId',  Result);                          03579000
  value                     PortDST, Plabel, NumSubques, ContextSize;   03580000
  integer          Result,  PortDST, Plabel, NumSubques, ContextSize;   03581000
  double                    PortId';                                    03582000
  option privileged,uncallable;                                         03583000
                                                                        03584000
  begin                                                                 03585000
  equate badparm1 = 1,                                                  03586000
         badparm2 = 2,                                                  03587000
         splitstk = 10,                                                 03588000
         nomore   = 11;                                                 03589000
  double PortId;                                                        03590000
  logical pointer PortCB = PortId +1;                                   03591000
  double pointer PortCB'dbl = PortCB;                                   03592000
                                                                        03593000
  integer aftioqx;                                                      03594000
  integer pointer msg,                                                  03595000
                  Context;                                              03596000
                                                                        03597000
  Result := 0;                                                          03598000
                                                                        03599000
                                                                        03600000
  CreatePort'(PortDST, 3, @IOWaitPort'server, NumSubques,               03601000
              ContextSize+IOWait'usercontext, PortId, Result);          03602000
  if Result <> 0 then go to Exit;                                       03603000
  aftioqx := Allocate'IOWait'index(PortId);                             03604000
  if aftioqx = 0 then                                                   03605000
    begin  << out of entries! >>                                        03606000
    DeletePort(PortId);                                                 03607000
    PortId := 0D;                                                       03608000
    Result := nomore;                                                   03609000
    go to Exit;                                                         03610000
    end;                                                                03611000
                                                                        03612000
  exchangedb(PortDST);                                                  03613000
                                                                        03614000
  << Initialize PortCB and context area >>                              03615000
  @Context := PortCB'context;                                           03616000
  PortCB'subtype := IOWait'subtype;                                     03617000
                                                                        03618000
  IOWait'portplabel := Plabel;                                          03619000
  IOWait'aftioqx := aftioqx;                                            03620000
  exchangedb(0);                                                        03621000
  PortId' := PortId;                                                    03622000
                                                                        03623000
Exit:  end;   << CreateIOWaitPort >>                                    03624000
$page "IOWait Ports - ChangeIOWaitPort"                                 03625000
integer procedure ChangeIOWaitPort(PortId,AFTindex,Pin,Plabel);         03626000
  value PortId,AFTindex,Pin,Plabel;                                     03627000
  double PortId;                                                        03628000
  integer AFTindex,Pin,Plabel;                                          03629000
  option privileged,uncallable;                                         03630000
                                                                        03631000
  begin                                                                 03632000
  << NOTE: must be called on stack assoc. with port >>                  03633000
  << NOTE: must be called with DB at stack DB >>                        03634000
  integer pointer Context;                                              03635000
  std'decl;                                                             03636000
                                                                        03637000
  if Pin = 0 then Pin := curpin;                                        03638000
                                                                        03639000
  exchangedb'to'PortDST;                                                03640000
  @Context := PortCB'context;                                           03641000
                                                                        03642000
  ChangeIOWaitPort := IOWait'softint'plabel;                            03643000
  IOWait'softint'plabel := Plabel;                                      03644000
  IOWait'aftindex := AFTindex;                                          03645000
  PortCB'pin := Pin;                                                    03646000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03647000
                                                                        03648000
  end;   << ChangeIOWaitPort >>                                         03649000
$page "IOWait Ports - IncrementIOCount"                                 03650000
integer procedure IncrementIOCount(PortId);                             03651000
  value PortId;                                                         03652000
  double PortId;                                                        03653000
  option privileged,uncallable;                                         03654000
                                                                        03655000
  begin                                                                 03656000
  << NOTE: must be called on stack assoc. with port >>                  03657000
  << NOTE: must be called with DB at stack DB >>                        03658000
  integer NewCount = IncrementIOCount;                                  03659000
  integer pointer Context,                                              03660000
                  aft;                                                  03661000
  integer ioqx,                                                         03662000
          fnum,   << aft index >>                                       03663000
          dl;     << DL Register value >>                               03664000
  std'decl;                                                             03665000
                                                                        03666000
  exchangedb'to'PortDST;                                                03667000
  @Context := PortCB'context;                                           03668000
                                                                        03669000
  fnum := IOWait'aftindex;                                              03670000
  ioqx := if IOWait'softint'plabel <> 0                                 03671000
            then softintpend                                            03672000
            else IOWait'aftioqx;                                        03673000
  disable;                                                              03674000
  IOWait'count := IOWait'count +1;                                      03675000
  NewCount := IOWait'count;                                             03676000
  enable;                                                               03677000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03678000
  if NewCount = 1 then                                                  03679000
    begin  << set ioqx into aft for IOWAITs use >>                      03680000
    push(dl);  dl := tos;                                               03681000
    @aft := -fnum*aftsize + dl - aft'base;                              03682000
    aft(to'ioqx) := ioqx;                                               03683000
    if ioqx = softintpend then PortEnable(PortId);                      03684000
    end;                                                                03685000
                                                                        03686000
  end;   << IncrementIOCount >>                                         03687000
$page "IOWait Ports - CheckIOCount"                                     03688000
integer procedure CheckIOCount(PortId);                                 03689000
  value PortId;                                                         03690000
  double PortId;                                                        03691000
  option privileged,uncallable;                                         03692000
                                                                        03693000
  begin                                                                 03694000
  integer pointer Context;                                              03695000
  std'decl;                                                             03696000
                                                                        03697000
  exchangedb'to'PortDST;                                                03698000
  @Context := PortCB'context;                                           03699000
  CheckIOCount := IOWait'count;                                         03700000
  exchangedb'back;  << CallersDB/AbsPortDB is popped >>                 03701000
                                                                        03702000
  end;   << CheckIOCount >>                                             03703000
$page "IOWait Ports - Allocate'IOWait'index"                            03704000
                                                                        03705000
integer procedure Allocate'IOWait'index(PortId);                        03706000
  value PortId;                                                         03707000
  double PortId;                                                        03708000
  option privileged,uncallable,internal;                                03709000
  begin                                                                 03710000
  double pointer IOWait'index = Allocate'IOWait'index;                  03711000
                                                                        03712000
  << IOWait Port Vector Table structure >>                              03713000
  Integer CurrentDSTSize = DB +0,                                       03714000
          MaxDSTSize = DB +1;                                           03715000
  integer pointer Index'PoolHead = DB +2,                               03716000
                  Index'PoolTail = DB +3;                               03717000
  integer LockWord = DB +4;  << obtain/release need four words! >>      03718000
  equate IOWait'headersize = 8;                                         03719000
  equate nil = -1;                                                      03720000
                                                                        03721000
  << local variables >>                                                 03722000
                                                                        03723000
  integer pointer Index'element;                                        03724000
  integer oldsize,newsize;                                              03725000
                                                                        03726000
  if exchangedb(IOWait'PortId'DST) <> 0 then suddendeath(wrongDST);     03727000
  obtain(LockWord,nil);                                                 03728000
                                                                        03729000
  if @Index'PoolHead = 0 then                                           03730000
    begin  << try to expand DST >>                                      03731000
    oldsize := CurrentDSTSize;                                          03732000
    newsize := altdsegsize(IOWait'PortId'DST, 256);                     03733000
    if <> then                                                          03734000
      begin  << expansion failed, bail out >>                           03735000
      @IOwait'index := 0;                                               03736000
      release(LockWord,nil,true);                                       03737000
      exchangedb(0);                                                    03738000
      return;  << return to caller >>                                   03739000
      end;                                                              03740000
    @Index'element := oldsize;                                          03741000
    @Index'PoolHead := @Index'element;                                  03742000
    while @Index'element + 2 < newsize do                               03743000
      begin                                                             03744000
      @Index'element := Index'element := @Index'element +2;             03745000
      end;                                                              03746000
    @Index'PoolTail := @Index'element;                                  03747000
    CurrentDSTSize := @Index'element + 2;                               03748000
    end;  << DST expansion >>                                           03749000
                                                                        03750000
  @IOWait'index := @Index'PoolHead;                                     03751000
  @Index'PoolHead := Index'PoolHead;                                    03752000
  if = then                                                             03753000
    @Index'PoolTail := 0;  << Pool Now empty >>                         03754000
                                                                        03755000
  IOWait'index := PortId;                                               03756000
                                                                        03757000
  Release(LockWord,nil,true);                                           03758000
  exchangedb(0);                                                        03759000
                                                                        03760000
  end;   << Allocate'IOWait'index >>                                    03761000
$page "IOWait Ports - Release'IOWait'index"                             03762000
                                                                        03763000
procedure Release'IOWait'index(Index);                                  03764000
  value Index;                                                          03765000
  integer Index;                                                        03766000
  option privileged,uncallable,internal;                                03767000
  begin                                                                 03768000
  integer pointer IOWait'index;                                         03769000
                                                                        03770000
  << IOWait Port Vector Table structure >>                              03771000
  Integer CurrentSize = DB +0,                                          03772000
          MaxDSTSize = DB +1;                                           03773000
  Integer Pointer Index'PoolHead = DB +2,                               03774000
                  Index'PoolTail = DB +3;                               03775000
  integer LockWord = DB +4;  << obtain/release need four words! >>      03776000
  equate IOWait'headersize = 8;                                         03777000
  equate nil = -1;                                                      03778000
                                                                        03779000
  if exchangedb(IOWait'PortId'DST) <> 0 then suddendeath(wrongDST);     03780000
  obtain(LockWord,nil);                                                 03781000
                                                                        03782000
  @IOWait'index := Index;                                               03783000
  IOWait'index := 0;                                                    03784000
  if @Index'PoolHead <> 0 then                                          03785000
    begin  << Pool not empty, queue to tail >>                          03786000
    @Index'PoolTail := Index'PoolTail := @IOWait'index;                 03787000
    end                                                                 03788000
  else                                                                  03789000
    begin  << pool was empty, should never happen >>                    03790000
    @Index'PoolHead := @Index'PoolTail := @IOWait'index;                03791000
    end;                                                                03792000
                                                                        03793000
  Release(LockWord,nil,true);                                           03794000
  exchangedb(0);                                                        03795000
                                                                        03796000
  end;   << Release'IOWait'index >>                                     03797000
$page "IOWait Ports - sort fnums"                                       03798000
PROCEDURE sort(a,n);                                                    03799000
   VALUE n; INTEGER n;                                                  03800000
   DOUBLE ARRAY a;                                                      03801000
   OPTION INTERNAL;                                                     03802000
BEGIN <<Elements 1 to n of the array 'a' are sorted in place, using     03803000
        Floyd's treesort algorithm.  Each element is a double word.>>   03804000
   INTEGER f,s,          <<used to index up & down the tree>>           03805000
      root,              <<index of root of subtree>>                   03806000
      limit;             <<index of last node not yet sorted>>          03807000
   DOUBLE POINTER a1;    <<points to 1st element>>                      03808000
   LOGICAL done;         <<found correct tree location>>                03809000
   DOUBLE t;         <<used to hold one element>>                       03810000
                                                                        03811000
   limit:=n; @a1:=@a+2;     <<initialize locals>>                       03812000
                                                                        03813000
<<create the heap, i.e., insure that a(i)>a(2i) for all i>>             03814000
                                                                        03815000
   FOR root:=n&lsr(1) STEP -1 UNTIL 1 DO                                03816000
   BEGIN <<move a(root) down to correct place in subheap>>              03817000
      done :=  FALSE;                                                   03818000
      t:=a(root);                                                       03819000
      s:=root;                                                          03820000
      WHILE NOT done AND (s:=(f:=s)&lsl(1)) <= limit DO                 03821000
      BEGIN <<find bigger son>>                                         03822000
         IF < AND a(s)<a1(s) THEN s:=s+1; <<ccl from limit test>>       03823000
         IF t<a(s) THEN                                                 03824000
            BEGIN <<swap with bigger son>>                              03825000
               a(f):=a(s);                                              03826000
            END                                                         03827000
         ELSE done := TRUE;                                             03828000
      END;                                                              03829000
      a(f):=t;                                                          03830000
   END;  <<create heap>>                                                03831000
                                                                        03832000
<<Select phase.  At each step, 1st element is largest, so switch it     03833000
  and last, then move last to correct place in new heap.>>              03834000
                                                                        03835000
   WHILE limit>1 DO                                                     03836000
   BEGIN                                                                03837000
      t:=a(limit);     <<save last element>>                            03838000
      a(limit):=a1;                                                     03839000
      limit:=limit-1; s:=1;                                             03840000
                                                                        03841000
<<Move element down to bottom of tree, assuming it is less than anything03842000
  else.  This is usually true, so we should save some compares.>>       03843000
                                                                        03844000
      WHILE (s:=(f:=s)&lsl(1)) <= limit DO                              03845000
      BEGIN                                                             03846000
         IF < AND a(s)<a1(s) THEN s:=s+1; <<ccl from limit test>>       03847000
         a(f):=a(s);                                                    03848000
      END;                                                              03849000
                                                                        03850000
<<Now check from bottom up to see if we were wrong>>                    03851000
      WHILE (f:=(s:=f)&lsr(1)) > 0 AND a(f)<t DO                        03852000
         a(s):=a(f);                                                    03853000
      a(s):=t;                                                          03854000
   END <<selection>>;                                                   03855000
END <<sort>>;                                                           03856000
$page "IOWait Ports - IOWaitPort'expire"                                03857000
procedure IOWaitPort'expire;                                            03858000
  option privileged,uncallable;                                         03859000
  begin                                                                 03860000
comment  This procedure is called by the filesystem procedure           03861000
    "fprocterm" when a process terminates.  The intent is to            03862000
    release all resources associated with the current process.          03863000
    The assumption is that all of these resources may be located        03864000
    thru the AFT table.                                                 03865000
    IOWait ports are released in order, based upon the subtype.         03866000
    This allows, for example, remote files to be closed before          03867000
    the underlying remote connection is closed.                         03868000
  ;                                                                     03869000
  integer pointer pxfile;                                               03870000
  integer pointer aft;                                                  03871000
  integer pointer dl;                                                   03872000
                                                                        03873000
  integer fnum := 0,                                                    03874000
          num'entries := 0,                                             03875000
          last'subtype := -1,                                           03876000
          subtype'plabel := 0,                                          03877000
          identnum,                                                     03878000
          len,                                                          03879000
          num'afts,                                                     03880000
          sort'index;                                                   03881000
  double sort'info;                                                     03882000
  integer sort'subtype = sort'info,                                     03883000
          sort'fnum = sort'info +1;                                     03884000
  double pointer sort'table;  << alloc. array on TOS >>                 03885000
                                                                        03886000
  byte array procname(0:15);                                            03887000
  integer S0 = S-0;                                                     03888000
  intrinsic ascii,loadproc,unloadproc,debug;                            03889000
                                                                        03890000
  << Find all IOWaitPort AFTs, and produce a double word >>             03891000
  << for each such entry. This double word is constructed >>            03892000
  << from the aft subtype and the opposite of the aftindex. >>          03893000
  << The array of all such double words is then sorted in >>            03894000
  << assending order, producing a double array with all >>              03895000
  << AFTs of subtype zero first, followed by subtype one, etc. >>       03896000
  << Within a subtype, the largest aft index is first, due to >>        03897000
  << negating the aft index when constructing the sort entry. >>        03898000
  << A variable sized array to hold the list of IOWaitPort AFTs >>      03899000
  << is allocated on the top of stack since the maximum size >>         03900000
  << is not known. >>                                                   03901000
                                                                        03902000
  push(dl);                                                             03903000
  @dl := tos;                                                           03904000
  @pxfile := @dl - dl(-3);                                              03905000
  num'afts := pxfile(to'pxaftsize)/aftsize;                             03906000
  @sort'table := @S0 +1;                                                03907000
  asmb( dzro );  << space for sort'table(0) >>                          03908000
  << Must use while loop, since add to TOS! >>                          03909000
  while (fnum := fnum +1) <= num'afts do                                03910000
    begin                                                               03911000
    @aft := @dl - fnum*aftsize - aft'base;                              03912000
    if aft'type = iowaitport'type then                                  03913000
      begin                                                             03914000
      sort'subtype := aft'subtype;                                      03915000
      sort'fnum := -fnum;  << release largest fnum first >>             03916000
      num'entries := num'entries +1;                                    03917000
      << sort'table(num'entries) := sort'info; >>                       03918000
      tos := sort'info;                                                 03919000
      end;                                                              03920000
    end;                                                                03921000
                                                                        03922000
  move procname := "DCL'AFT' ";                                         03923000
                                                                        03924000
  if num'entries > 1 then sort(sort'table,num'entries);                 03925000
  for sort'index := 1 until num'entries do                              03926000
    begin                                                               03927000
    sort'info := sort'table(sort'index);                                03928000
    num'afts := pxfile(to'pxaftsize)/aftsize;                           03929000
    fnum := -sort'fnum;                                                 03930000
    @aft := @dl - fnum*aftsize - aft'base;                              03931000
    if fnum <= num'afts and aft(0) <> 0 then                            03932000
      begin  << aft still exists, try to close it >>                    03933000
      if sort'subtype <> last'subtype then                              03934000
        begin  << load the plabel for the new subtype >>                03935000
        if subtype'plabel <> 0 then                                     03936000
          unloadproc(identnum);                                         03937000
        len := ascii(sort'subtype,10,procname(8));                      03938000
        procname(len + 8) := " ";                                       03939000
        identnum := loadproc(procname,0,subtype'plabel);                03940000
        if <> then                                                      03941000
          begin                                                         03942000
          << Identnum is the error code in this case. >>                03943000
          << No such errors are allowed.  Potential recovery >>         03944000
          << may consist of logging the error, then zeroing >>          03945000
          << the AFT entry. >>                                          03946000
          debug;                                                        03947000
          end;                                                          03948000
        last'subtype := sort'subtype;                                   03949000
        end;                                                            03950000
      << call "DCL'AFT'nn(fnum);" to cleanup aft >>                     03951000
      tos := fnum;                                                      03952000
      tos := subtype'plabel;                                            03953000
      asmb( pcal 0 );                                                   03954000
      end;                                                              03955000
    end;                                                                03956000
                                                                        03957000
  if subtype'plabel <> 0 then                                           03958000
    unloadproc(identnum);                                               03959000
                                                                        03960000
  end;  << IOWaitPort'expire >>                                         03961000
$PAGE "MESSAGE FACILITY INTRINSICS : SEND MESSAGE"                      03962000
PROCEDURE SENDMSG(DESTPIN,SUBQUEUE,MSGLENGTH,FLAGS);                    03963000
VALUE DESTPIN,SUBQUEUE,MSGLENGTH,FLAGS;                                 03964000
INTEGER DESTPIN,SUBQUEUE,MSGLENGTH;                                     03965000
LOGICAL FLAGS;                                                          03966000
OPTION PRIVILEGED,UNCALLABLE;                                           03967000
                                                                        03968000
COMMENT                                                                 03969000
                                                                        03970000
SENDMSG IS CALLED TO DELIVER A SHORT MESSAGE OF MSGLENGTH WORDS         03971000
TO THE SPECIFIED SUBQUEUE OF THE PROCESS                                03972000
SPECIFIED BY DESTPIN.                                                   03973000
                                                                        03974000
THE FLAGS PARAMETER CONTROLS THE PROCEDURE AS FOLLOWS :                 03975000
                                                                        03976000
    FLAGS.MSGWAKEUPFLAG=1 ==> WAKE-UP DESTINATION PROCESS        HM.XX  03977000
    FLAGS.MSGDONT'PREEMPTFLAG=1 ==> DON'T BOTHER PREEMPTING THE CURRENT 03978000
                                    PROCESS TO GET THIS MESSAGE         03979000
                                                                        03980000
                                                                        03981000
                                                                        03982000
                                                                        03983000
                                                                        03984000
                                                                        03985000
SENDMSG EXPECTS THE FIRST WORD OF THE MESSAGE TO BE AT Q-7-MSGLENGTH    03986000
AND THE LAST WORD TO BE AT Q-8.  ON EXIT THE STACKED MESSAGE CONTENTS   03987000
ARE DELETED.                                                            03988000
                                                                        03989000
IF THE FLAGS SPECIFY THAT THE DESTINATION PROCESS BE AWAKENED, THE      03990000
RETURN CC IS SET TO CCG IF THE PROCESS IS ALREADY AWAKE.                03991000
                                                                        03992000
THE MESSAGE CONTENTS STACKED BY THE CALLER ARE DELETED ON THE EXIT      03993000
FROM SENDMSG.                                                           03994000
                                                                        03995000
;                                                                       03996000
                                                                        03997000
                                                                        03998000
BEGIN                                                                   03999000
                                                                        04000000
DEFINE MSGDON'TPREEMPTFLAG = (2:1)#;                                    04001000
DEFINE MSGWAKEUPFLAG = (1:1)#;                                          04002000
                                                                        04003000
EQUATE PARMCNT=4,  <<INCOMING PARAMETER COUNT>>                         04004000
       LASTMSGWORD=4+PARMCNT;                                           04005000
                                                                        04006000
ARRAY MSGARRAY(*)=Q-LASTMSGWORD; <<STARTS AT Q-8>>                      04007000
                                                                        04008000
COMMENT                                                                 04009000
                                                                        04010000
ALL CALLS TO THIS PROCEDURE SHOULD BE REPLACED WITH                    04011000
CALLS TO THE PORT PROCEDURE PRIMITIVES DIRECTLY.                        04012000
                                                                        04013000
;                                                                       04014000
EQUATE MAXSUBQUEUE = 4,    << SUBQUEUES 0-4 VALID >>                    04015000
       MAXMSGLENGTH = 4;                                                04016000
                                                                        04017000
EQUATE MSGADJUSTMENT = LASTMSGWORD +1;                                  04018000
DOUBLE PORTID;                                                          04019000
                                                                        04020000
INTEGER SAVE1,                                                          04021000
        SAVE2;                                                          04022000
                                                                        04023000
<< "intrinsic(fname) send'q;" doesn't work with xref. >>                04024000
procedure Send'Q(PortId,Subqueue,Message);                              04025000
  value PortId,Subqueue,Message;                                        04026000
  double PortId;                                                        04027000
  integer Subqueue;                                                     04028000
  integer Message;   << Message is the caller's Qreg relative           04029000
                        address. >>                                     04030000
  option external;                                                      04031000
                                                                        04032000
IF NOT ( 0 <= SUBQUEUE <= MAXSUBQUEUE) THEN                             04033000
  SUDDENDEATH(BADPORTCALL);                                             04034000
                                                                        04035000
IF NOT (0 <= DESTPIN <= MAX'PIN) THEN                                   04036000
  SUDDENDEATH(BADPORTCALL);                                             04037000
                                                                        04038000
IF NOT (0 <= MSGLENGTH <= MAXMSGLENGTH) THEN                            04039000
  SUDDENDEATH(BADPORTCALL);                                             04040000
                                                                        04041000
<< FIND THE PORTID GIVEN PIN >>                                         04042000
                                                                        04043000
PORTID := FINDPROCESSPORT(IF DESTPIN=0 THEN -1 ELSE DESTPIN);           04044000
                                                                        04045000
<< THE NEW PORT PRIMITIVES REQUIRE A TWO WORD HEADER >>                 04046000
<< WORD ZERO IS RESERVED FOR THE SUBQUEUE ON >>                         04047000
<< RECEIVES, AND WORD ONE IS THE MESSAGE'S LENGTH, >>                   04048000
<< INCLUDING THE HEADER >>                                              04049000
                                                                        04050000
SAVE1 := MSGARRAY( -(MSGLENGTH+1) );                                    04051000
SAVE2 := MSGARRAY(X:=X+1);                                              04052000
MSGARRAY(X) := MSGLENGTH +2;                                            04053000
                                                                        04054000
SEND'Q(PORTID,SUBQUEUE,-(MSGLENGTH + MSGADJUSTMENT));                   04055000
                                                                        04056000
<< NOW, RESTORE THE ORIGINAL USER'S STACK >>                            04057000
                                                                        04058000
MSGARRAY( -(MSGLENGTH+1) ) := SAVE1;                                    04059000
MSGARRAY(X:=X+1) := SAVE2;                                              04060000
                                                                        04061000
<<WAKE-UP DESTINATION PROCESS IF CALLER SO REQUESTED>>                  04062000
                                                                        04063000
IF FLAGS.MSGWAKEUPFLAG                                                  04064000
THEN AWAKE(DESTPIN*PCBSIZE,MSGWAITCODE,NOWAIT);                         04065000
IF DESTPIN=0 THEN                                                       04066000
   BEGIN  <<SPECIAL FOR SCHEDULER MESSAGES>>                            04067000
   IF ABSOLUTE(SYSDISPAWAKEMSG).DISPRUNNINGFLAG                         04068000
   AND NOT ABSOLUTE(SYSDISPAWAKEMSG).PAUSEDFLAG                         04069000
   THEN ABSOLUTE(SYSAWAKESCHEDMSG):=0 <<PREEMPT CUR ACT>>               04070000
    ELSE IF (NOT FLAGS.MSGDON'TPREEMPTFLAG)                             04071000
    OR (ABSOLUTE(SYSDISPAWAKEMSG).PAUSEDFLAG) THEN ASMB(DISP);          04072000
   END;                                                                 04073000
                                                                        04074000
<<BUILD AND EXECUTE AN EXIT INSTRUCTION TO DELETE STACKED MSG>>         04075000
                                                                        04076000
TOS:=MSGLENGTH+PARMCNT;  <<# OF PARAMETERS TO DELETE>>                  04077000
TOS:=TOS LOR (%31400);  <<BUILD EXIT INSTRUCTION>>                      04078000
ASMB(XEQ 0);                                                            04079000
END  <<PROCEDURE SENDMSG>>;                                             04080000
$PAGE "MESSAGE FACILITY INTRINSICS : PORT STATUS"                       04081000
INTEGER PROCEDURE PORTSTATUS(SUBQUEUE);                                 04082000
VALUE SUBQUEUE;                                                         04083000
INTEGER SUBQUEUE;                                                       04084000
OPTION PRIVILEGED,UNCALLABLE;                                           04085000
                                                                        04086000
COMMENT                                                                 04087000
                                                                        04088000
WHEN SUPPLIED A VALID SUBQUEUE, PORTSTATUS RETURNS A TRUE               04089000
VALUE IF THE SUBQUEUE IS NON-EMPTY AND A FALSE VALUE IF THE SUBQUEUE    04090000
IS EMPTY.                                                               04091000
                                                                        04092000
WHEN PASSED A -1 AS PORTNUMBER PARAMETER, PORTSTATUS RETURNS            04093000
THE PORTNUMBER OF THE PROCESS' MOST URGENT NON-EMPTY SUBQUEUE (WHERE    04094000
THE CONVENTION OF LOWER NUMERICAL SUBQUEUE NUMBERS RELATING TO MORE     04095000
URGENT SUBQUEUE IS UNDERSTOOD).                                         04096000
                                                                        04097000
IF ALL SUBQUEUES ARE EMPTY, PORTSTATUS RETURNS CC=CCE.  IF AT LEAST     04098000
ONE SUBQUEUE IS NON-EMPTY, PORTSTATUS RETURNS CC=CCG.                   04099000
                                                                        04100000
;                                                                       04101000
                                                                        04102000
                                                                        04103000
BEGIN                                                                   04104000
                                                                        04105000
COMMENT                                                                 04106000
                                                                        04107000
ALL CALLS TO THIS PROCEDURE SHOULD BE REPLACED WITH                    04108000
CALLS TO THE PORT PROCEDURE PRIMITIVES DIRECTLY.                        04109000
                                                                        04110000
;                                                                       04111000
EQUATE MAXSUBQUEUE = 4,    << SUBQUEUES 0-4 VALID >>                    04112000
       MAXMSGLENGTH = 4;                                                04113000
                                                                        04114000
DOUBLE PORTID;                                                          04115000
                                                                        04116000
INTEGER CALLERPIN;                                                      04117000
                                                                        04118000
<< FIND THE CALLER'S PIN.  PIN := -1 IF CALLED BY DISPATCHER >>         04119000
                                                                        04120000
IF ABSOLUTE(CPCB) = 0                                                   04121000
  THEN CALLERPIN := -1 << ON THE ICS >>                                 04122000
    ELSE CALLERPIN := curpin;                                           04123000
                                                                        04124000
<< FIND THE PORTID GIVEN PIN >>                                         04125000
                                                                        04126000
PORTID := FINDPROCESSPORT(CALLERPIN);                                   04127000
                                                                        04128000
PORTSTATUS := FALSE;  << ASSUME NO MESSAGES PENDING >>                  04129000
CC := CCE;                                                              04130000
                                                                        04131000
TOS := NEWPORTSTATUS(PORTID,0);  << MSG PENDING MASK >>                 04132000
ASSEMBLE( TEST );                                                       04133000
IF <> THEN                                                              04134000
  BEGIN  << AT LEAST ONE SUBQUEUE NON-EMPTY >>                          04135000
  CC := CCG;                                                            04136000
  IF SUBQUEUE <> -1 THEN                                                04137000
    BEGIN  << CHECK SPECIFIC SUBQUEUE >>                                04138000
    IF NOT (0 <= SUBQUEUE <= MAXSUBQUEUE) THEN                          04139000
      SUDDENDEATH(BADPORTCALL);                                         04140000
    << XREG SET BY COMPARE RANGE ABOVE >>                               04141000
    ASSEMBLE( TBC 0,X );                                                04142000
    IF <> THEN PORTSTATUS := TRUE;                                      04143000
    END                                                                 04144000
  ELSE                                                                  04145000
    BEGIN  << RETURN HIGHEST PRIORITY NON-EMPTY SUBQUEUE >>             04146000
    ASSEMBLE( SCAN );                                                   04147000
    PORTSTATUS := X;                                                    04148000
    IF X > MAXSUBQUEUE THEN SUDDENDEATH(BADPORT);                       04149000
    END;                                                                04150000
  END;                                                                  04151000
END  <<PROCEDURE PORTSTATUS>>;                                          04152000
$PAGE "MESSAGE FACILITY INTRINSICS : RECEIVE MESSAGE"                   04153000
PROCEDURE RECEIVEMSG(SUBQUEUE,MSGLENGTH,FLAGS);                         04154000
VALUE SUBQUEUE,MSGLENGTH,FLAGS;                                         04155000
INTEGER SUBQUEUE,MSGLENGTH;                                             04156000
LOGICAL FLAGS;                                                          04157000
OPTION PRIVILEGED,UNCALLABLE;                                           04158000
                                                                        04159000
COMMENT                                                                 04160000
                                                                        04161000
RECEIVEMSG IS CALLED TO OBTAIN THE CONTENTS OF THE MESSAGE              04162000
AT THE HEAD OF THE CALLING PROCESS' MSG PORT (SPECIFIED                 04163000
BY SUBQUEUE PARAMETER).                                                 04164000
                                                                        04165000
THE CALLER OF RECEIVEMSG DOES AN ASMB(ADDS MSGLENGTH) TO MAKE           04166000
SPACE FOR THE MSG CONTENTS.  RECEIVEMSG DEPOSITS THE MSG CONTENTS       04167000
INTO Q-7-MSGLENGTH,...,Q-8, WITH THE FIRST WORD OF THE SENT             04168000
MESSAGE DEPOSITED INTO Q-7-MSGLENGTH.                                   04169000
                                                                        04170000
THE CALLER HAS THE OPTION OF A NON-DESTRUCTIVE READ OF THE MESSAGE.     04171000
FLAGS.MSGNONDESTRUCT=1 ==> RETURN CONTENTS OF MESSAGE, BUT LEAVE        04172000
                           MESSAGE AT THE HEAD OF THE SUBQUEUE.         04173000
FLAGS.MSGWAITONEMPTY=1 ==> WAIT THE CALLER ON A MESSAGE WAIT            04174000
                           IF THE QUEUE IS EMPTY. (PROCESS              04175000
                           WILL BE REAWAKENED WHEN SOMEBODY             04176000
                           SENDS A MESSAGE TO THE SPECIFIED             04177000
                           SUBQUEUE).                                   04178000
                                                                        04179000
STATUS IS RETURNED THRU THE CC AS FOLLOWS :                             04180000
                                                                        04181000
   IF ALL SUBQUEUES ARE EMPTY AND WAIT NOT SPECIFIED CC:=CCG.           04182000
   IF A MSG BEING RETURNED, CC:=CCE.                                    04183000
                                                                        04184000
                                                                        04185000
;                                                                       04186000
                                                                        04187000
BEGIN                                                                   04188000
                                                                        04189000
DEFINE MSGNONDESTRUCT = (0:1)#,                                         04190000
       MSGWAITONEMPTY = (1:1)#;                                         04191000
                                                                        04192000
EQUATE PARMCNT=3,                                                       04193000
       LASTMSGWORD=4+PARMCNT;                                           04194000
                                                                        04195000
ARRAY MSGARRAY(*)=Q-LASTMSGWORD;  <<STARTS AT Q-7>>                     04196000
                                                                        04197000
COMMENT                                                                 04198000
                                                                        04199000
ALL CALLS TO THIS PROCEDURE SHOULD BE REPLACED WITH                    04200000
CALLS TO THE PORT PROCEDURE PRIMITIVES DIRECTLY.                        04201000
                                                                        04202000
;                                                                       04203000
EQUATE MAXSUBQUEUE = 4,    << SUBQUEUES 0-4 VALID >>                    04204000
       MAXMSGLENGTH = 4;                                                04205000
                                                                        04206000
EQUATE MSGADJUSTMENT = LASTMSGWORD +1;                                  04207000
DOUBLE PORTID;                                                          04208000
                                                                        04209000
INTEGER SAVE1,                                                          04210000
        SAVE2;                                                          04211000
                                                                        04212000
INTEGER CALLERPIN;                                                      04213000
                                                                        04214000
LOGICAL SUBQUEUEMASK;                                                   04215000
                                                                        04216000
<< "intrinsic(fname) receive'q,replace'q;" doesn't work with xref. >>   04217000
procedure Receive'Q(PortId,Message,EnableMask);                         04218000
  value PortId,Message,EnableMask;                                      04219000
  double PortId;                                                        04220000
  integer Message;   << Message is the caller's Qreg relative           04221000
                        address. >>                                     04222000
  logical EnableMask;                                                   04223000
  option external;                                                      04224000
                                                                        04225000
procedure Replace'Q(PortId,Subqueue,Message);                           04226000
  value PortId,Subqueue,Message;                                        04227000
  double PortId;                                                        04228000
  integer Subqueue;                                                     04229000
  integer Message;   << Message is the caller's Qreg relative           04230000
                        address. >>                                     04231000
  option external;                                                      04232000
                                                                        04233000
<< FIND THE CALLER'S PIN.  PIN := -1 IF CALLED BY DISPATCHER >>         04234000
                                                                        04235000
IF ABSOLUTE(CPCB) = 0                                                   04236000
  THEN CALLERPIN := -1  << ON THE ICS >>                                04237000
    ELSE CALLERPIN := curpin;                                           04238000
                                                                        04239000
<< FIND THE PORTID GIVEN PIN >>                                         04240000
                                                                        04241000
PORTID := FINDPROCESSPORT(CALLERPIN);                                   04242000
                                                                        04243000
<< THE NEW PORT PRIMITIVES REQUIRE A TWO WORD HEADER >>                 04244000
<< WORD ZERO IS RESERVED FOR THE SUBQUEUE ON >>                         04245000
<< RECEIVES, AND WORD ONE IS THE MESSAGE'S LENGTH, >>                   04246000
<< INCLUDING THE HEADER >>                                              04247000
                                                                        04248000
SAVE1 := MSGARRAY( -(MSGLENGTH+1) );                                    04249000
SAVE2 := MSGARRAY(X:=X+1);                                              04250000
                                                                        04251000
<< SET THE SUBQUEUE MASK CORRESPONDING TO PORTNUM >>                    04252000
                                                                        04253000
TOS := 0;                                                               04254000
X := SUBQUEUE;                                                          04255000
ASSEMBLE( TSBC 0,X );                                                   04256000
SUBQUEUEMASK := TOS;                                                    04257000
                                                                        04258000
IF NOT ( 0 <= X <= MAXSUBQUEUE) THEN                                    04259000
  SUDDENDEATH(BADPORTCALL);                                             04260000
                                                                        04261000
CC := CCE;  << ASSUME EVERY THING WORKED >>                             04262000
TRY'AGAIN:                                                              04263000
                                                                        04264000
RECEIVE'Q(PORTID,-(MSGLENGTH + MSGADJUSTMENT),SUBQUEUEMASK);            04265000
IF FLAGS.MSGNONDESTRUCT AND MSGARRAY( -(MSGLENGTH+1) ) <> -1 THEN       04266000
  REPLACE'Q(PORTID,SUBQUEUE,-(MSGLENGTH + MSGADJUSTMENT));              04267000
IF MSGARRAY( -(MSGLENGTH+1) ) = -1 THEN  << NO MESSAGES PRESENT >>      04268000
  BEGIN                                                                 04269000
  IF FLAGS.MSGWAITONEMPTY THEN                                          04270000
    BEGIN                                                               04271000
    WAIT(MSGWAITCODE,NOINFO);                                           04272000
    GOTO TRY'AGAIN;                                                     04273000
    END                                                                 04274000
  ELSE CC := CCG;  <<NOWAIT OPTION>>                                    04275000
  END;                                                                  04276000
                                                                        04277000
IF NOT (0 <= INTEGER(MSGARRAY(-MSGLENGTH) -2) <= MAXMSGLENGTH) THEN     04278000
  SUDDENDEATH(BADPORT);                                                 04279000
                                                                        04280000
IF X > MSGLENGTH THEN  << COMPARE RANGE ABOVE SETS X >>                 04281000
  SUDDENDEATH(BADPORTCALL);                                             04282000
                                                                        04283000
<< NOW, RESTORE THE ORIGINAL USER'S STACK >>                            04284000
                                                                        04285000
MSGARRAY( -(MSGLENGTH+1) ) := SAVE1;                                    04286000
MSGARRAY(X:=X+1) := SAVE2;                                              04287000
END  <<PROCEDURE RECEIVEMSG>>;                                          04288000
$page "PortDictionary routines"                                         04289000
procedure DictAdd(Name,Data,Result);                                    04290000
  integer array Name,Data;                                              04291000
  integer Result;                                                       04292000
  option privileged,uncallable;                                         04293000
  begin                                                                 04294000
  entry DictUpdate,DictFind,DictDelete,DictSend;                        04295000
                                                                        04296000
  equate ok = 0,  << Result codes >>                                    04297000
         already'exists =1,                                             04298000
         not'found = 2,                                                 04299000
         table'full = 3;                                                04300000
                                                                        04301000
  integer pointer DictEntry,                                            04302000
                  HashBucket,                                           04303000
                  PrevBucket;                                           04304000
                                                                        04305000
  byte pointer bptr0,bptr1;                                             04306000
                                                                        04307000
  byte array BName(*) = Name;                                           04308000
  logical OldState;                                                     04309000
  integer function,                                                     04310000
          Old'DST,                                                      04311000
          length,                                                       04312000
          HashValue;                                                    04313000
  integer DL'Name,DL'Data;  << DL Reg. relative addresses >>            04314000
  integer pointer Q'Data;  << Q reg. relative addressing >>             04315000
  integer array QM0array(*) = Q-0;  << for Q rel. addressing of Data >> 04316000
  double PortId;                                                        04317000
  integer portId0 = portId,                                             04318000
          PortId1 = PortId +1;                                          04319000
                                                                        04320000
  equate nil = -1;   << used by obtain and release >>                   04321000
  integer pointer Dict'element;                                         04322000
  integer oldsize,newsize;                                              04323000
                                                                        04324000
  equate Port'Dict'DSTN = 17;                                           04325000
                                                                        04326000
  << dictionary DST structure >>                                        04327000
  integer CurrentDSTSize = DB +0,                                       04328000
          MaxDSTSize = DB +1;                                           04329000
  integer pointer Dict'PoolHead = DB +2,                                04330000
                  Dict'PoolTail = DB +3;                                04331000
  integer LockWord = DB +4;   << obtain/release need four words! >>     04332000
  integer array DictHashTable(*) = DB +8;                               04333000
                                                                        04334000
  equate Dict'HeaderSize = 8,  << obtain/release need four words! >>    04335000
         NumHash'Buckets = 95; << same hash function as USL >>          04336000
                                                                        04337000
  << DictEntry structure >>                                             04338000
  equate NameIndex = 1,  << offset to 16 byte array >>                  04339000
         NameLength = 8, << word length of name array >>                04340000
         DataIndex = 9,  << offset to 7 word array >>                   04341000
         PortIdIndex = 9,  << PortId is first two words of data >>      04342000
         DataLength = 7, << length of word array >>                     04343000
         Dict'EntrySize = 16;  << length of total entry >>              04344000
                                                                        04345000
  subroutine free(entry'ptr);                                           04346000
    value entry'ptr;                                                    04347000
    integer pointer entry'ptr;                                          04348000
    begin                                                               04349000
    entry'ptr := 0;  << next link ptr := nil >>                         04350000
    if @Dict'PoolHead <> 0 then                                         04351000
      begin  << free pool not empty >>                                  04352000
      @Dict'PoolTail := Dict'PoolTail := @entry'ptr;                    04353000
      end                                                               04354000
    else                                                                04355000
      begin  << free pool empty, shouldn't happen >>                    04356000
      @Dict'PoolHead := @Dict'PoolTail := @entry'ptr;                   04357000
      end;                                                              04358000
    end;   << free >>                                                   04359000
                                                                        04360000
  subroutine DictExit(code);                                            04361000
    value code;                                                         04362000
    integer code;                                                       04363000
    begin                                                               04364000
    if @DictEntry <> 0 then free(DictEntry);                            04365000
    release(LockWord,nil,1);                                            04366000
    exchangedb(Old'DST);                                                04367000
    Result := code;                                                     04368000
    if OldState then PortEnable(PortId);                                04369000
    asmb( exit 3);  << bail out of procedure! >>                        04370000
    end;  << DictExit >>                                                04371000
                                                                        04372000
  subroutine DictHash;                                                  04373000
    begin                                                               04374000
    << NOTE: This is the same hash funtion as USL and SL files. >>      04375000
                                                                        04376000
    length := integer(BName).(12:4);  << first char is BName length >>  04377000
    tos := length&lsl(8) + integer(BName(1));                           04378000
    if length = 1                                                       04379000
      then asmb( dup )                                                  04380000
      else tos := integer(BName(length-1))&lsl(8) +                     04381000
                  integer(BName(x:=x+1));                               04382000
    tos := 95;                                                          04383000
    asmb( ldiv,delb );                                                  04384000
    HashValue := tos;                                                   04385000
    end;   << DictHash >>                                               04386000
                                                                        04387000
<< set the function code based upon entry point called >>               04388000
                                                                        04389000
<<DictAdd>>  function := 0;  goto start;                                04390000
DictUpdate : function := 1;  goto start;                                04391000
DictFind   : function := 2;  goto start;                                04392000
DictDelete : function := 3;  goto start;                                04393000
DictSend   : function := 4;<<goto start;>>                              04394000
                                                                        04395000
<< common code for all entry points >>                                  04396000
start :                                                                 04397000
  turn'traps'off;                                                       04398000
  DictHash;  << sets HashValue using BName>>                            04399000
  push( DL );   << calc. DL relative addresses for MVLB instr >>        04400000
  asmb( neg,dup );                                                      04401000
  DL'Name := tos + @Name;                                               04402000
  DL'Data := tos + @Data;                                               04403000
                                                                        04404000
  OldState := FALSE;                                                    04405000
  Old'DST := exchangedb(Port'Dict'DSTN);                                04406000
  obtain(LockWord,nil);                                                 04407000
                                                                        04408000
  << allocate a Dict. entry bucket as a scratch area >>                 04409000
                                                                        04410000
  @DictEntry := @Dict'PoolHead;                                         04411000
  if = then                                                             04412000
    suddendeath(badport);  << shouldn't happen >>                       04413000
  @Dict'PoolHead := Dict'PoolHead;                                      04414000
  if = then                                                             04415000
    @Dict'PoolTail := 0;  << free pool is now empty >>                  04416000
  DictEntry := 0;  << Next link ptr >>                                  04417000
  @bptr0 := @DictEntry(NameIndex)&lsl(1);  << for byte compare >>       04418000
                                                                        04419000
  if Old'DST = 0 then                                                   04420000
    begin  << move from stack to DictDSTN >>                            04421000
    << move Name from stack to DictDST >>                               04422000
    tos := @DictEntry(NameIndex);                                       04423000
    tos := DL'Name;                                                     04424000
    tos := NameLength;                                                  04425000
    asmb( mvlb 3 );                                                     04426000
                                                                        04427000
    if function < 2 then                                                04428000
      begin  << Add and Update >>                                       04429000
      << move Data from stack to DictDST >>                             04430000
      tos := @DictEntry(DataIndex);                                     04431000
      tos := DL'Data;                                                   04432000
      tos := DataLength;                                                04433000
      asmb( mvlb 3 );                                                   04434000
      end;                                                              04435000
    end                                                                 04436000
  else                                                                  04437000
    begin  << move from XDS to DictDSTN >>                              04438000
<<+*+>> << NOTE!  This will have to change when "fast" exchangedb >>    04439000
<<+*+>> <<        is called, because the "from" DST may be absent! >>   04440000
    << move Name from XDS to DictDST >>                                 04441000
    tos := @DictEntry(NameIndex);                                       04442000
    tos := Old'DST;                                                     04443000
    tos := @Name;                                                       04444000
    tos := NameLength;                                                  04445000
    asmb( mfds 4 );                                                     04446000
                                                                        04447000
    if function < 2 then                                                04448000
      begin  << Add and Update >>                                       04449000
      << move Data from XDS to DictDST >>                               04450000
      tos := @DictEntry(DataIndex);                                     04451000
      tos := Old'DST;                                                   04452000
      tos := @Data;                                                     04453000
      tos := DataLength;                                                04454000
      asmb( mfds 4 );                                                   04455000
      end;                                                              04456000
    end;                                                                04457000
                                                                        04458000
    tos := Old'DST;                                                     04459000
  << search for a match >>                                              04460000
  @PrevBucket := @DictHashTable(HashValue);                             04461000
  @HashBucket := PrevBucket;                                            04462000
  while <> do                                                           04463000
    begin                                                               04464000
    @bptr1 := @HashBucket(NameIndex)&lsl(1);                            04465000
    if bptr0 = bptr1,(length+1) then goto found;                        04466000
    << not found, continue search >>                                    04467000
    @PrevBucket := @HashBucket;                                         04468000
    @HashBucket := HashBucket;  << Next link ptr >>                     04469000
    end;                                                                04470000
                                                                        04471000
  << didn't find a match >>                                             04472000
  if function = 0 then                                                  04473000
    begin  << add >>                                                    04474000
    if @Dict'PoolHead = 0 then                                          04475000
      begin  << try to expand DST >>                                    04476000
      << The DictDST is expanded only on DictAdds.  This is done so     04477000
         that the error "table'full" will be returned only on Add.      04478000
         All the other entry points get an entry durring processing,    04479000
         but release the entry before exiting.  Therefore, a "full"     04480000
         DictDST always has one free entry. >>                          04481000
      oldsize := CurrentDSTSize;                                        04482000
      newsize := altdsegsize(Port'Dict'DSTN, 1024);                     04483000
      if <> then                                                        04484000
        begin  << expansion failed, bail out >>                         04485000
        DictExit(table'full);  << return to caller >>                   04486000
        end;                                                            04487000
                                                                        04488000
      @Dict'element := oldsize;                                         04489000
      @Dict'PoolHead := @Dict'element;                                  04490000
      while @Dict'element + Dict'EntrySize < newsize do                 04491000
        begin                                                           04492000
        @Dict'element := Dict'element := @Dict'element + Dict'EntrySize;04493000
        end;                                                            04494000
      @Dict'PoolTail := @Dict'element;                                  04495000
      CurrentDSTSize := @Dict'element + Dict'EntrySize;                 04496000
      end;  << DST expansion >>                                         04497000
                                                                        04498000
    PrevBucket := @DictEntry;  << link entry to tail >>                 04499000
    @DictEntry := 0;  << so DictExit doesn't free it >>                 04500000
    DictExit(ok);                                                       04501000
    end                                                                 04502000
  else                                                                  04503000
    begin  << update, find, delete, or send >>                          04504000
    DictExit(not'found);                                                04505000
    end;                                                                04506000
                                                                        04507000
found :   << found a match >>                                           04508000
  case function of                                                      04509000
    begin                                                               04510000
                                                                        04511000
    begin  << add >>                                                    04512000
    DictExit(already'exists);                                           04513000
    end;                                                                04514000
                                                                        04515000
    begin  << update >>                                                 04516000
    move HashBucket(DataIndex) := DictEntry(DataIndex),(DataLength);    04517000
    end;                                                                04518000
                                                                        04519000
    begin  << find >>                                                   04520000
    if Old'DST = 0 then                                                 04521000
      begin  << move Data from DictDST to stack >>                      04522000
      tos := DL'Data;                                                   04523000
      tos := @HashBucket(DataIndex);                                    04524000
      tos := DataLength;                                                04525000
      asmb( mvbl 3 );                                                   04526000
      end                                                               04527000
    else                                                                04528000
      begin  << move Data from DictDST to XDS >>                        04529000
<<+*+>> << NOTE!  This will have to change when "fast" exchangedb >>    04530000
<<+*+>> <<        is called, because the "from" DST may be absent! >>   04531000
      tos := Old'DST;                                                   04532000
      tos := @Data;                                                     04533000
      tos := @HashBucket(DataIndex);                                    04534000
      tos := DataLength;                                                04535000
      asmb( mtds 4 );                                                   04536000
      end;                                                              04537000
    end;                                                                04538000
                                                                        04539000
    begin  << delete >>                                                 04540000
    PrevBucket := HashBucket;  << delink entry >>                       04541000
    free(HashBucket);                                                   04542000
    end;                                                                04543000
                                                                        04544000
    begin  << send >>                                                   04545000
<< NOTE: DictSend expects subqueue to be specified in word >>           04546000
<<       zero of Data.  This is NOT consistant with the    >>           04547000
<<       'regular' Send primitives, which have a parameter >>           04548000
<<       to select the subqueue.  This was done to fit into>>           04549000
<<       the alternate entry point technique used by the   >>           04550000
<<       other dictionary routines.                        >>           04551000
                                                                        04552000
    if Old'DST = 0 then                                                 04553000
      begin  << send from stack >>                                      04554000
      push(q,dl);  << calc. Q rel. Data address >>                      04555000
      asmb( xch,sub );   << Q rel DL >>                                 04556000
      @Q'Data := tos + DL'Data;                                         04557000
      PortId0 := HashBucket(PortIdIndex);                               04558000
      PortID1 := hashBucket(PortIdIndex +1);                            04559000
      OldState := PortDisable(PortId);                                  04560000
      Send'Q(PortId,QM0array(@Q'Data),Q'Data);                          04561000
      end                                                               04562000
    else                                                                04563000
      begin  << send from XDS >>                                        04564000
<<+*+>> << ?????  This may have to change when "fast" exchangedb >>     04565000
<<+*+>> <<        is called, because the "from" DST may be absent! >>   04566000
      PortId0 := HashBucket(PortIdIndex);                               04567000
      PortID1 := hashBucket(PortIdIndex +1);                            04568000
      exchangedb(Old'DST);                                              04569000
      OldState := PortDisable(PortId);                                  04570000
      Send'DB(PortId,Data,Data);                                        04571000
      exchangedb(Port'Dict'DSTN);                                       04572000
      end;                                                              04573000
    end;                                                                04574000
                                                                        04575000
    end;   << end case >>                                               04576000
                                                                        04577000
  DictExit(ok);  << Update/Find/Delete/Send >>                          04578000
                                                                        04579000
  end;  << DictAdd/Update/Find/Delete/Send >>                           04580000
$page "debugger"                                                        04581000
procedure HelpMe;                                                       04582000
  option privileged,uncallable,internal;                                04583000
  begin                                                                 04584000
  help;  << need a call to allow help breakpoints >>                    04585000
  end;                                                                  04586000
                                                                        04587000
procedure badpcal;                                                      04588000
  option privileged,uncallable,internal;                                04589000
  begin                                                                 04590000
  << This procedure must be last! >>                                    04591000
  << This procedure is called if a "PCAL 0" with tos = 0 is done. >>    04592000
  suddendeath(badport);                                                 04593000
  end;                                                                  04594000
                                                                        04595000
$control segment=seg'                                                   04596000
end.                                                                    04597000
