⟦d983e2e65⟧

TextFile

$listoff
stdenv;
(*--------------------------------------------
--
--             system standard environment for rtp
--
--   87.09.27   tog   first version.
--   92.06.04   hej   type bufparamtype added.
--   92.06.12   hej   a number of open routines added ( eg. for imc ).
--                    - type compilerid_type
--   92.06.19   hej    the type of index changed:  byte -> integer,
--                    - parameter of locktest changed: mailbox -> reference.
--   92.06.29   hej   like telebit: add nl  alfalength to stdenv.
--   92.08.20   bb    the shielded type declarations modified to fit
--                    the standard library of closed routines
--                    heap.env is included. more open routines included.
--   92.09.01   hej   fields in system objects are made unused by ?,
--		      switch systemenv used,
--		      addr, break_by_father, returnx,  signalx made public.
--
-----------------------------------------------
*)

(***** predefined constants *****)
const
alfalength = 12;
maxint     = 32767;
minint     = -32768;

(******************************)
(***** predefined types *******)
(******************************)
type

bit = 0..1;

byte = 0..255;


conn_service = (cs_normal, cs_high);

const create_ok=0;
      create_process_not_nil=1;
      create_program_not_linked=2;
      create_no_memory=3;

type create_result = create_ok .. create_no_memory;

const
maxpriority = 0;
minpriority = -2;
stdpriority = minpriority;

type
priotype = minpriority..maxpriority;


event_type = (not_event, message_event, answer_event,
              process_removed, port_closed, disconnected,
              letter_sent, letter_arrived,
              local_connect, remote_connect,
              reset_indication, reset_completion,
              credit, data_sent, data_arrived, data_overrun,
              dummy_letter, dummy_lcnct, dummy_rcnct,
              dummy_rindic, dummy_rcmpl, dummy_credit,
              dummy_sent, dummy_arrived,
              msl_message, msl_answer, test_event);

const link_ok=0;
      link_not_found=1;
      link_no_parameter_match=3;
      link_already_linked=6;

type link_result=link_ok..link_already_linked;

const unlink_ok=0;
      unlink_no_program_linked=1;
      unlink_program_busy=2;

type unlink_result=unlink_ok..unlink_program_busy;

const mem_private = 0;

type mem_type = mem_private..mem_private;

reason_type = (reason_ok, reason_name, reason_resource,
               reason_closed, reason_network);

scope_type = (anonymous, local, regional, global);

string(length: byte) = array(1..length) of char;

alfa = string(12);

activation = (a_interrupt, a_mailbox, a_delay);

control_type = 
packed record
  rcv_all,
  get_credit: boolean;
end;


(* implementation dependent constants  types   *)
----------------------------------------------------

const

nl         = lf;
break_by_father =  47;

type

(* addr is used in io.env     *)

xmem_no_type = 0..127;

base_type = 
packed record
  mem_no : xmem_no_type;
  nilbit : bit
end;

addr = 
record
  nulbyte : byte;
  base    : base_type;
  disp    : integer
end;

coded_date =
packed record
  year_after_1900: 0..127;
  month: 0..12;
  day: 0..31;
end;

coded_time =
packed record
  compiler_version : 0..31;
  hour: 0..23;
  minute: 0..59;
end;

coded_secs =
packed record
  sec: 0..59;
  msec: 0..999;
end;

coded_inc =
packed record
  days: 0..31;
  hours: 0..23;
  mins: 0..59;
  secs: 0..59;
  msecs: 0..999;
end;

delaytype =
packed record
  prev_date: coded_date;
  prev_time: coded_time;
  prev_secs: coded_secs;
  inc : coded_inc;
end;

clocktype =
packed record
  date: coded_date;
  time: coded_time;
  secs: coded_secs;
end;

tversion =
record
  release   ,
  subrelease: byte;
end;

compilerid_type =
packed record
  packageidentification : 0..7;
  compilerrelease       : 0..31;
  compilersubrelease    : 0..255
end;

(*  package   ident_value  compiler        *)
--   sw2101        1      old rtp35  rc8000
--   sw2104        2      rtp86
--   sw2103        3      rtp35
--   sw2111        4      rtp2111    rc8000
--   sw2114        5      rtp


tmoduleversion =
record
  moduledate: coded_date;
  moduletime: coded_time;
  moduleversion: tversion;
  compilationdate: coded_date;
  compilationtime: coded_time;
$if target = rc3502
  compilerid  : compilerid_type;
$endif
end;

descriptor_segment =
record
  descriptor_length,
  no_of_pages      ,
  pagesize         ,
  last_page_length ,
  kind             : integer;
  name             : alfa;
  entry_point      : addr;
  exception_point  : addr;
  default_appetite ,
  last_param_offset: integer;
  source_date      : coded_date;
  source_time      : coded_time;
  version          : integer;
  compilerid       : compilerid_type;
  no_of_params     : integer;
end;


$if systemenv = 0
(******************************)
(* shielded type declarations in std environment for the compiler *)
(******************************)

mailbox_ = 
record
  ?    : addr; -- message_headers or register_sets
  ?    : ^ mailbox; -- used by remove
end;

pool_ = 
record
  ?    : addr; -- message_headers or register_sets
  ?    : ^ integer; -- ^ pool  used by remove
end;


process_ =
record
  proc : ^ integer; -- address of process descriptor
  next : ^ integer; -- ^ process   used by remove
end;

reference_ =
record
  ?      : byte;        --  locked : byte;
  ?      : ^ integer;   --  header : ^ message_header;
  ?      : ^ integer;   --  next   : ^ reference;
end;

chain_ =
record
 ?      : ^ integer;       -- current chain_element
 ?      : ^ integer;       -- start chain_element
 ?      : 0..maxint;       -- no of chain_elements in chain
end;

port_ =
record
  ?           : byte;
  ?           : ^ mailbox;
  ?           : mailbox;
  ?           : mailbox;
  ?           : mailbox;
end;

program_descriptor = -- the "type" of a program
record
-- used by link and unlink
 ?                  : integer; -- no of incarnations of this program
 ?                  : ^ integer;      -- address of formal parameters
 ?                  : integer; -- 0: unlinked
 --                               1: internal linked
 --                               2: external linked
 ?                  : ^ integer;   -- pointer to descriptorsegment
 --                                            if external linked
 --                                            pointer to program_inf
 --                                            if internal linked
 ?                  : alfa;
 ?                  : ^ integer;   --  addr program_descriptor  used by remove
end;

$endif

$if systemenv = 1
(******************************)
(* shielded type declarations in system environment  *)
(******************************)


adr = 
record
  base : base_type;
  disp : integer
end;

mailbox_ = 
record
  mbx  : addr; -- message_headers or register_sets
  next : ^ mailbox; -- used by remove
end;

pool_ = 
record
  mbx  : addr; -- message_headers or register_sets
  next : ^ pool; -- used by remove
end;

process_descriptor_p;
process_ =
record
  proc : process_descriptor_p; -- address of process descriptor
  next : ^ process; -- used by remove
end;

message_header_p;
message_header =
record
  nulbyte          : byte;
  chain            : message_header_p;
  u1               : byte;
  u2               : byte;
  u3               : byte;
  u4               : byte;
  messagekind      : integer;
  size             : integer;
  start            : addr;
  owner            : ^ mailbox;
  answer           : ^ mailbox;
  msgchain         : message_header_p;
  stackchain       : message_header_p;
  connection_index : byte;
  credit_count     : byte;
  reason           : byte;
  event_kind       : byte;
end;
message_header_p = ^ message_header;

reference_ =
record
  locked : byte;
  header : ^ message_header;
  next   : ^ reference;
end;

chain_element_p;
chain_element =
record
  r    : reference;
  up   : chain_element_p;
  down : chain_element_p;
end;
chain_element_p = ^ chain_element;

chain_ =
record
 cur    : ^ chain_element; -- current chain_element
 start  : ^ chain_element; -- start chain_element
 length : 0..maxint; -- no of chain_elements in chain
end;

port_ =
record
  index_limit : byte;
  imc_box     : ^ mailbox;
  port_active : mailbox;
  port_ready  : mailbox;
  port_answer : mailbox;
end;

shared_descr = -- controls access to a shared variable
record
  r      : reference; -- message containing shared variable
  object : ^ mailbox; -- synchs access to shared variable
end;

program_inf =
record
  entry_point       : adr;
  exception_point   : adr;
  default_appetite  : integer;
  last_param_offset : integer
end;

const
maxparams = 30; (* must match pass5  crosslink values !!! *)

type

param_descr =
record
  kind ,
  size : integer;
end;

param_array = array (1..maxparams) of param_descr;

param_record =
record
  no_of_params : integer;
  params       : param_array;
end;

ext_linktable_entry =
record
  name   : alfa;
  params : param_record;
end;


program_descriptor_p;
program_descriptor = -- the "type" of a program
record
-- used by link and unlink
 count              : integer; -- no of incarnations of this program
 paramptr           : ^ param_record; -- address of formal parameters
 state              : integer; -- 0: unlinked
 --                               1: internal linked
 --                               2: external linked
 programinf         : ^ descriptor_segment; -- pointer to descriptorsegment
 --                                            if external linked
 --                                            pointer to program_inf
 --                                            if internal linked
 prgname            : alfa;
 next               : program_descriptor_p; -- used by remove
end;
program_descriptor_p = ^ program_descriptor;

programrec = -- used by create
record
  programref             : ^ program_descriptor;
  firstparam             : ^ byte;
  size_of_params         : integer;
end;

mbxtype = (deallocatormbx,linkermbx,stopmbx,allocmbx,exceptionmbx,
  opmbx,restart_mbx,stop_msg,writerammbx,addrmbx,testoutputmbx,commonpool,
  monitormbx,printstatmbx,timermbx,iotimermbx,_adammbx,
  timerbase,exceptionstack,monitorstack,
  timerstack,allocatorstack,linkerstack,operatorstack);

secret_vector = array (mbxtype) of 
record
  nulbyte : byte;
  p       : ^ mailbox;
end;


process_descriptor =
record
-- the process descriptor appearing as the first part of global frame
  timer                   : integer;
  level                   : byte;
  delaychain              : process_descriptor_p;
  exceptioncode           : integer;
  exic                    : addr;
  exceptionpoint          : addr;
  maxstack                : integer;
  regset                  : integer;
  mregset                 : integer;
  procstate               : integer;
  programref              : ^ program_descriptor; -- in fathers stack
  mbxchain                : ^ mailbox;
  refchain                : ^ reference;
  processchain            : ^ process;
  msgchain                : ^ message_header;
  programchain            : ^ program_descriptor; -- in own stack
  workmbx                 : mailbox;
  secretpointer           : ^ secret_vector;
  workref                 : reference;
  plinetable              : ^ byte;
  procname                : alfa;
  father                  : process_descriptor_p;
  processref              : ^ process; (* in fathers stack *)
end;
process_descriptor_p = ^ process_descriptor;

$endif


(*********************************)
(*****  predefined routines  *****)
(*********************************)


function abs(n: integer): integer;
openroutine;


procedure alloc( var r: reference; var p: pool; var ra: mailbox);
external;

function allocdelay(var r: reference; var p:pool; var ra: mailbox;
                     ms: integer): activation;
external;

function allocmempool(var p: pool; no_of_bufs, bufsize: integer;
mem: mem_type): integer;
external;

function allocpool=allocpool_rc
         (var p: pool; no_of_bufs, bufsize: integer): integer;
external;

procedure break(var proc: process; fault: integer);
external;

function bufcount(var r: reference): integer;
external;

function bufsize(var r: rtype    ): integer;
openroutine;


function bytecount(var r: rtype   ): integer;
external;

procedure chaindequeue(var ref: reference; var ch: chain);
external;

procedure chaindown(var ch: chain);
external;

procedure chainenqueue(var ref: reference; var ch: chain);
external;

function chainlength(var ch: chain): integer;
openroutine;


procedure chainreset(var ch: chain);
openroutine;


procedure chainstart(var ch: chain);
openroutine;


procedure chainup(var ch: chain);
external;

function ord(v: btype): integer; 
openroutine;


function ord(v: wtype): integer; openroutine;
function chr(v: byte): char;
openroutine;



function create(inspect incname: string; var prog: program_descriptor;
     var pr: process; size: integer; prio: integer): create_result;
external;

function creditcount(var r: reference): integer;
openroutine;


procedure dec(var v: byte);
openroutine;


procedure dec(var v: integer);
openroutine;


procedure delay(ms: integer);
openroutine;


function eventkind(var r: rtype): event_type;
openroutine;


procedure exception(c: integer);
external;

function hometest(var r: rtype; var p: pool): boolean;
external;

procedure inc(var v: byte);
openroutine;


procedure inc(var v:integer);
openroutine;


function index(var r:reference): integer;
openroutine;



function link(inspect incname: string;var prog: program_descriptor):
              link_result;
external;

function locked(var m:mailbox): boolean;
openroutine;


function locktest(var r: reference): boolean;
openroutine;


procedure new(var p: ptype); external;

function nil(var p:ptype  ): boolean; openroutine;
function nil(var p:process): boolean;
openroutine;


function nil(var p:reference): boolean;
openroutine;


function offset(var r:rtype    ): integer;
openroutine;


function open(var m:mailbox): boolean; openroutine;
function openpool(var p: pool): boolean;
openroutine;


function passive(var m:mailbox): boolean;
openroutine;


procedure pop(var b,s: reference);
openroutine;


function pred(v: btype): btype; openroutine;
function pred(v: wtype): wtype;
openroutine;


procedure push(var b,s: reference);
openroutine;


function reason(var r:reference): reason_type;
openroutine;


procedure release(var r: reference);
openroutine;


function releasepool(var p:pool; bufs: integer): integer;
external;

procedure remove(var pr: process);
external;

procedure resetevent(var r: rtype);
openroutine;


procedure resume(var pr: process);
external;

procedure return(var r:reference);
openroutine;


procedure setbytecount(var r: rtype    ; v: integer);
external;

procedure setoffset=setoffset_rc(var r: rtype    ; v: integer);
external;

procedure settop=settop____rc(var r: rtype    ; v: integer);
external;

procedure setu1(var r: rtype    ; v: byte);
external;

procedure setu2(var r: rtype    ; v: byte);
external;

procedure setu3(var r: rtype    ; v: byte);
external;

procedure setu4(var r: rtype    ; v: byte);
external;

procedure signal(var r: reference; var m:mailbox);
openroutine;


function stackdepth(var r:reference  ): integer;
external;

procedure start(var pr: process; prio: integer);
external;

procedure stop(var p: process);
external;

function succ(v:btype): btype; openroutine;
function succ(v:wtype): wtype;
openroutine;


procedure tofrom=tofrom____rc(var toref: reference; toindex: integer;
                 var fromref: reference; fromindex: integer;
                 bytes: integer );
external;

function top(var r:rtype    ): integer;
openroutine;


procedure trace = exception(f: integer);
external;

procedure stacktrace = exception(f: integer);
external;

function unlink(var prog: program_descriptor): integer;
external;

function u1(var r:rtype    ): byte;
openroutine;


function u2(var r:rtype    ): byte;
openroutine;


function u3(var r:rtype    ): byte;
openroutine;


function u4(var r:rtype    ): byte;
openroutine;


procedure wait( var r: reference; var m: mailbox);
openroutine;


function waitdelay(var r: reference; var m: mailbox;
                   ms: integer): activation;
external;

procedure closeport(var p: port);
external;

procedure connect(var p:port; index:1..maxint; var compl, disc: reference;
                  inspect remote_name:string; service: conn_service);
external;

procedure disconnect(var p:port; index:1..maxint);
external;

procedure getconnection(var p:port; index:1..maxint; var compl, disc:reference);
external;

procedure getcredit(var p:port; index:1..maxint; var credbuf: reference);
external;

procedure getreset(var p:port; index:1..maxint; var indic: reference);
external;

function maxconnections:integer;
external;

procedure openport(var p:port; var closebuf: reference;
                   inspect name:string; scope: scope_type;
                   no_of_cons: 0..maxint; cntrl: control_type);
external;

procedure receive(var p:port; index:1..maxint; var databuf: reference);
external;

procedure receiveall(var p:port; var databuf: reference);
external;

procedure reset(var p:port; index:1..maxint; var compl: reference);
external;

procedure send(var p:port; index:1..maxint; var databuf: reference);
external;


(* implementation dependent standard routines and types*)

type

lookup_descriptor_segment =
record
  name             : alfa;
  descriptor_length,
  no_of_pages      ,
  pagesize         ,
  last_page_length ,
  kind             : integer;
  default_appetite ,
  last_param_offset,
  no_of_params     : integer;
  date             : coded_date;
  time             : coded_time;
  source_date      : coded_date;
  source_time      : coded_time;
  version          : integer;
--  $  if target = rc3502
--     compilerid  : compilerid_type;    --   later  ?
--  $  endif
end;

(*  *)

function alias( var p: port; inspect name: string ): boolean;
external;

function clock_difference( t1, t2: clocktype ): coded_inc;
external;

function clock_increment( t: clocktype; inc: coded_inc ): clocktype;
external;

function clock_less_than( t1, t2: clocktype ): boolean;
external;

function crc16( op1, op2 : integer ): integer;
openroutine;


function crc16buf( var r: reference;
  frombyte, tobyte : integer;
  quotient, startvalue : integer ): integer;
external;

function deletemailbox(inspect mbx_name: string): integer;
external;

function getclock: clocktype;
external;

function imcpresent: boolean;
external;

procedure getservers( var r: reference; inspect mask: string );
external;

function namemailbox(var m: mailbox; inspect mbx_name: string): integer;
external;

function ownname(var name:string): byte;
external;

function ownprogramname(var name:string): byte;
external;

procedure ownversion(var myversion: tmoduleversion);
external;

function searchmailbox(inspect mbx_name: string): ^mailbox;
external;

procedure sendadam=sendadam__rc(var ref: reference );
external;

procedure sendlinker=sendlinkerrc(var ref: reference );
external;

procedure sendtimer=sendtimer_rc(var ref: reference );
external;

procedure setownname(inspect name: string );
external;

procedure setpriority(priority : integer);
external;

function swap(n: integer): integer;
openroutine;


(* implementation demendent open routines *)

--procedure breakpoint;
--external;

procedure  definetimer( on: boolean );
external;

--function equalhome(var a: rtype    ; var b: rtype    ): boolean;
--external;

--function homeless(var r: rtype    ): boolean;
--external;

function madd( a, b: integer): integer;
openroutine;


function mmul( a, b: integer): integer;
openroutine;


function msub( a, b: integer): integer;
openroutine;


function rotate( a, shl: integer): integer;
openroutine;


function uadd( a, b: integer): integer;
openroutine;


function udiv( a, b: integer): integer;
openroutine;


function ult( a, b: integer): boolean;
openroutine;


function umod( a, b: integer): integer;
openroutine;


function umul( a, b: integer): integer;
openroutine;


function usub( a, b: integer): integer;
openroutine;



(* input-output  interrupt routines *)
procedure clearinterrupt;
openroutine;


procedure control(c: integer; var chmsg: reference);
openroutine;


procedure controlclr(c: integer);
openroutine;


function ctrwaitid(c: integer; ms: integer): activation;
openroutine;


function ctrwaitim(c: integer; var r: reference; var m: mailbox): activation;
openroutine;


function ctrwaitimd(c: integer; var r: reference; var m: mailbox;
                   ms: integer ): activation;
openroutine;


function eoi : boolean;
openroutine;


type
 bufparamtype =  array ( 1..8 ) of byte;

procedure getbufparam(var bufparam : bufparamtype;
                      first, last: integer; var msg: reference);
openroutine;


procedure inbyteblock( var next : integer;
  first, last: integer;
  var msg : reference );
openroutine;


procedure inword(var word: integer; var chmsg: reference);
openroutine;


procedure inwordblock( var next : integer;
  first, last: integer;
  var msg : reference );
openroutine;


procedure inwordclr(var word: integer);
openroutine;


procedure iowbwc(bufparam : bufparamtype);
openroutine;


function messagekind( var r: reference ): integer;
openroutine;


procedure outbyteblock( var next : integer;
  first, last: integer;
  var msg : reference );
openroutine;


procedure outword(word : integer; var chmsg: reference);
openroutine;


procedure outwordblock( var next : integer;
  first, last: integer;
  var msg : reference );
openroutine;


procedure outwordclr(word : integer);
openroutine;


procedure returnx (var r:reference);
openroutine;


procedure sense(var status: integer; status_out : integer;
                var chmsg: reference);
openroutine;


procedure senseclr(var status: integer; status_out : integer;
                   compare, mask: integer);
openroutine;


procedure setinterrupt(var ch : reference);
openroutine;


procedure signalx(var r: reference; var m:mailbox);
openroutine;


function timedout: boolean;
openroutine;


procedure waiti;
openroutine;


function waitid( msecs: integer ): activation;
openroutine;


function waitim( var r: reference; var m : mailbox ): activation;
openroutine;


function waitimd ( var r: reference; var m : mailbox;
  msecs : integer ): activation;
openroutine;



$if systemenv = 1
---------------------------------------------------------------
(*             extra routines for imc                        *)
---------------------------------------------------------------

procedure excptcall ( errno: integer);
openroutine;


procedure setcreditcount ( var r:reference; credits: byte);
openroutine;


procedure seteventkind ( var r:reference; event: event_type);
openroutine;


procedure setindex ( var r:reference; index: byte);
openroutine;


procedure setreason ( var r:reference; reason: reason_type);
openroutine;


----------------------------------------
(*         other useful routines      *)
----------------------------------------

const

heap_buffersize = 256; (* bytes , default size of user part in heapbuffer *)

ok              = 0;
overlap         = 1;
no_resources    = 2;
not_found       = 1;

type

name_entry_p;
name_entry = (* record in the list of cataloged mailbox names *)
record
  next_name_entry : name_entry_p;
  mbxptr          : ^ mailbox; (* the cataloged mailbox *)
  name            : alfa; (* the mailbox is cataloged under this name *)
end;
name_entry_p = ^ name_entry;

const

name_entry_size = typesize (name_entry);

type

call_remote_zone =
record
  r      : reference;
  remote : ^ mailbox;
  p      : pool;
  m      : mailbox;
  name   : alfa;
end;

type

heap_head_p;
heap_head = (* system part of a heap buffer *)
record
  size             : integer; (* words , used by allocator *)
  next_heap_head   : heap_head_p;
  next_free        : ^ byte; (* first free byte in this buffer *)
  no_of_free_bytes : integer; (* in this buffer *)
end;
heap_head_p = ^ heap_head;

const

heap_head_size = typesize (heap_head);
default_size   = heap_head_size + heap_buffersize;

type

heap_root = (* record pointed out by the field 'own.heap' *) 
record
  size                : integer; (* words , used by allocator *)
  first_heap_head     : ^ heap_head; (* queue of heap buffers *)
  last_heap_head      : ^ heap_head;
  name_catalog        : ^ name_entry; (* mailbox name list *)
  free_names          : ^ name_entry; (* free nodes for name_catalog *)
  cur_catalog         : ^ byte; --fs_catalog_connection; (* current catalog *)
  lfparammbx          : ^ mailbox; (* param resource mailbox *)
  lf3502mbx           : ^ mailbox; (* mainmailbox for lf3502 access methode *)
  remote_rec          : ^ call_remote_zone; (* record for call_remote params *)
  lf_mask             : set of 0..15; --lf_exceptions;  
  heap_refchain       : ^ reference;
  free_chain_elements : ^ chain_element;
end;

const

heap_root_size = typesize (heap_root);

new_appetite   = 22 + 14; (* words *)

procedure _initchainrc (ch : ^ chain);
openroutine;


function addptr1 ( anyptr: ^ integer; incr: integer): ^ integer; openroutine;
function addptr2 ( anyptr: ^ process_descriptor; incr: integer): ^ process_descriptor; openroutine;
function addptr3 ( anyptr: ^ descriptor_segment; incr: integer): ^ descriptor_segment; openroutine;
function addptr4 ( anyptr: ^ byte; incr: integer): ^ byte; openroutine;
function addptr5 ( anyptr: ^ heap_head; incr: integer): ^ byte; openroutine;
function addptr6 ( anyptr: ^ byte; incr: integer): ^ mailbox; openroutine;
function addptr7 ( anyptr: ^ descriptor_segment; incr: integer): ^ program_inf; openroutine;
function addptr8 ( anyptr: ^ process_descriptor; incr: integer): ^ integer; openroutine;
function addptr9 ( anyptr: ^ descriptor_segment; incr: integer): ^ addr;
openroutine;


function addrptr1 ( anyptr: ^ process_descriptor): addr; openroutine;
function addrptr2 ( anyptr: ^ program_descriptor): addr; openroutine;
function addrptr3 ( anyptr: ^ heap_root): addr; openroutine;
function addrptr4 ( anyptr: ^ heap_head): addr; openroutine;
function addrptr5 ( anyptr: ^ byte): addr;
openroutine;


procedure balloc;
openroutine;


procedure bcheck;
openroutine;


function bcrc16buffer (frombyte, tobyte: integer; var r: reference): integer;
openroutine;


function bhometest (var p : pool; var r : reference): boolean;
openroutine;


procedure bregion___rc;
openroutine;


procedure breg_exit_rc;
openroutine;


procedure bsetfirst;
openroutine;


procedure bsetlast;
openroutine;


procedure bsetnext;
openroutine;


procedure bsetownname (inspect n: alfa);
openroutine;


procedure bsetu1;
openroutine;


procedure bsetu2;
openroutine;


procedure bsetu3;
openroutine;


procedure bsetu4;
openroutine;


procedure btofrom;
openroutine;


type
artype = array (1..maxint) of byte;
arptr  = ^ artype;

function bufstart (var r : reference): ^ artype;
openroutine;


procedure bunchainref;
openroutine;


function bwaitdelay(var r: reference; var m: mailbox;
                   ms: integer): activation;
openroutine;


function carry : boolean;
openroutine;


function first (var r : reference): integer;
openroutine;


function getheap (var proc : process_descriptor) : ^ heap_root;
openroutine;


procedure getinteger ( var dest: integer; srcaddr: addr);
openroutine;


procedure getlfgf ( var lf, gf: addr);
openroutine;


function getown : ^ process_descriptor;
openroutine;


procedure getregister ( var dest: integer; index: integer);
openroutine;


function last (var r : reference): integer;
openroutine;


procedure linkmessage (var r : reference);
openroutine;


procedure movebytes1 (dest: ^ process_descriptor; source: ^ byte; bytes: integer); openroutine;
procedure movebytes2 (dest, source: ^ byte; bytes : integer);
openroutine;


function next (var r : reference): integer;
openroutine;


procedure pexit3;
openroutine;


function ptr ( var a: integer): ^ process_descriptor;
openroutine;


function ptraddr1 (a : addr) : ^ reference; openroutine;
function ptraddr2 (a : addr) : ^ process; openroutine;
function ptraddr3 (a : addr) : ^ mailbox; openroutine;
function ptraddr4 (a : addr) : ^ program_descriptor; openroutine;
function ptraddr5 (a : addr) : ^ message_header; openroutine;
function ptraddr6 (a : addr) : ^ process_descriptor; openroutine;
function ptraddr7 (a : addr) : ^ clocktype; openroutine;
function ptraddr8 (a : addr) : ^ byte; openroutine;
function ptraddr9 (a : addr) : ^ heap_root; openroutine;
function ptraddr10(a : addr) : ^ heap_head;
openroutine;


procedure readbyte ( var dest, src: byte);
openroutine;


procedure readram ( var dest: byte; ramindex: integer);
openroutine;


procedure readword ( var dest, src: integer);
openroutine;


function refmailbox ( var m: mailbox): ^ mailbox;
openroutine;


function refpool (var p : pool): ^ mailbox;
openroutine;


function refprocess (var proc : process): ^ process;
openroutine;


procedure selectlevel (level : integer);
openroutine;


procedure sensembx ( var r: reference; var m: mailbox);
openroutine;


procedure setheap (p : ^ heap_root);
openroutine;


procedure writeram ( ramindex, data: integer);
openroutine;


procedure writeramclr ( ramindex, data: integer);
openroutine;


$endif
.
DataMuseum.dk

DANOSI

⟦d983e2e65⟧ TextFile

Derivation

TextFile
