|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 32631 (0x7f77)
Types: TextFile
Names: »RTPSTD35.ENV«
└─⟦a2a1ee6f0⟧ Bits:30010509 PN:798-55-071 DVBS1.SW2114.rel.2.19-1
└─⟦this⟧ »RTPSTD35.ENV«
$listoff\r\r
stdenv;\r\r
\r\r
(*----------------------------------------------------------------- \r\r
-- \r\r
-- (c) copyrigth 1992 danosi \r\r
-- \r\r
--\r\r
-- system standard environment for rtp\r\r
--\r\r
------------------------------------------------------------------- \r\r
-- \r\r
-- revisions \r\r
-- -------------------------------- \r\r
-- \r\r
-- 1.1 87.09.27 tog first version.\r\r
-- 1.2 92.06.04 hej type bufparamtype added.\r\r
-- 1.3 92.06.12 hej a number of open routines added ( eg. for imc ).\r\r
-- - type compilerid_type\r\r
-- 1.4 92.06.19 hej the type of index changed: byte -> integer,\r\r
-- - parameter of locktest changed: mailbox -> reference.\r\r
-- 1.5 92.06.29 hej like telebit: add nl alfalength to stdenv.\r\r
-- 1.6 92.08.20 bb the shielded type declarations modified to fit\r\r
-- the standard library of closed routines\r\r
-- heap.env is included. more open routines included.\r\r
-- 1.7 92.09.01 hej fields in system objects are made unused by ?,\r\r
-- switch systemenv used,\r\r
-- addr, break_by_father, returnx, signalx made public.\r\r
-- 1.7 92.10.22 hej sccs unix used. \r\r
--\r\r
------------------------------------------------------------------- \r\r
-- sccs information \r\r
-- file : /usr2/sw2114/sysenv/s.rtpstd35.src \r\r
-- module : rtpstd35.src \r\r
-- version: 1.7 \r\r
-- date : 92/10/22 12:49:40 \r\r
------------------------------------------------------------------- \r\r
*)\r\r
\r\r
(***** predefined constants *****)\r\r
const\r\r
alfalength = 12;\r\r
maxint = 32767;\r\r
minint = -32768;\r\r
\r\r
(******************************)\r\r
(***** predefined types *******)\r\r
(******************************)\r\r
type\r\r
\r\r
bit = 0..1;\r\r
\r\r
byte = 0..255;\r\r
\r\r
\r\r
conn_service = (cs_normal, cs_high);\r\r
\r\r
const create_ok=0;\r\r
create_process_not_nil=1;\r\r
create_program_not_linked=2;\r\r
create_no_memory=3;\r\r
\r\r
type create_result = create_ok .. create_no_memory;\r\r
\r\r
const\r\r
maxpriority = 0;\r\r
minpriority = -2;\r\r
stdpriority = minpriority;\r\r
\r\r
type\r\r
priotype = minpriority..maxpriority;\r\r
\r\r
\r\r
event_type = (not_event, message_event, answer_event,\r\r
process_removed, port_closed, disconnected,\r\r
letter_sent, letter_arrived,\r\r
local_connect, remote_connect,\r\r
reset_indication, reset_completion,\r\r
credit, data_sent, data_arrived, data_overrun,\r\r
dummy_letter, dummy_lcnct, dummy_rcnct,\r\r
dummy_rindic, dummy_rcmpl, dummy_credit,\r\r
dummy_sent, dummy_arrived,\r\r
msl_message, msl_answer, test_event);\r\r
\r\r
const link_ok=0;\r\r
link_not_found=1;\r\r
link_no_parameter_match=3;\r\r
link_already_linked=6;\r\r
\r\r
type link_result=link_ok..link_already_linked;\r\r
\r\r
const unlink_ok=0;\r\r
unlink_no_program_linked=1;\r\r
unlink_program_busy=2;\r\r
\r\r
type unlink_result=unlink_ok..unlink_program_busy;\r\r
\r\r
const mem_private = 0;\r\r
\r\r
type mem_type = mem_private..mem_private;\r\r
\r\r
reason_type = (reason_ok, reason_name, reason_resource,\r\r
reason_closed, reason_network);\r\r
\r\r
scope_type = (anonymous, local, regional, global);\r\r
\r\r
string(length: byte) = array(1..length) of char;\r\r
\r\r
alfa = string(12);\r\r
\r\r
activation = (a_interrupt, a_mailbox, a_delay);\r\r
\r\r
control_type = \r\r
packed record\r\r
rcv_all,\r\r
get_credit: boolean;\r\r
end;\r\r
\r\r
\r\r
(* implementation dependent constants types *)\r\r
----------------------------------------------------\r\r
\r\r
const\r\r
\r\r
nl = lf;\r\r
break_by_father = 47;\r\r
\r\r
type\r\r
\r\r
(* addr is used in io.env *)\r\r
\r\r
xmem_no_type = 0..127;\r\r
\r\r
base_type = \r\r
packed record\r\r
mem_no : xmem_no_type;\r\r
nilbit : bit\r\r
end;\r\r
\r\r
addr = \r\r
record\r\r
nulbyte : byte;\r\r
base : base_type;\r\r
disp : integer\r\r
end;\r\r
\r\r
coded_date =\r\r
packed record\r\r
year_after_1900: 0..127;\r\r
month: 0..12;\r\r
day: 0..31;\r\r
end;\r\r
\r\r
coded_time =\r\r
packed record\r\r
compiler_version : 0..31;\r\r
hour: 0..23;\r\r
minute: 0..59;\r\r
end;\r\r
\r\r
coded_secs =\r\r
packed record\r\r
sec: 0..59;\r\r
msec: 0..999;\r\r
end;\r\r
\r\r
coded_inc =\r\r
packed record\r\r
days: 0..31;\r\r
hours: 0..23;\r\r
mins: 0..59;\r\r
secs: 0..59;\r\r
msecs: 0..999;\r\r
end;\r\r
\r\r
delaytype =\r\r
packed record\r\r
prev_date: coded_date;\r\r
prev_time: coded_time;\r\r
prev_secs: coded_secs;\r\r
inc : coded_inc;\r\r
end;\r\r
\r\r
clocktype =\r\r
packed record\r\r
date: coded_date;\r\r
time: coded_time;\r\r
secs: coded_secs;\r\r
end;\r\r
\r\r
tversion =\r\r
record\r\r
release ,\r\r
subrelease: byte;\r\r
end;\r\r
\r\r
compilerid_type =\r\r
packed record\r\r
packageidentification : 0..7;\r\r
compilerrelease : 0..31;\r\r
compilersubrelease : 0..255\r\r
end;\r\r
\r\r
(* package ident_value compiler *)\r\r
-- sw2101 1 old rtp35 rc8000\r\r
-- sw2104 2 rtp86\r\r
-- sw2103 3 rtp35\r\r
-- sw2111 4 rtp2111 rc8000\r\r
-- sw2114 5 rtp\r\r
\r\r
\r\r
tmoduleversion =\r\r
record\r\r
moduledate: coded_date;\r\r
moduletime: coded_time;\r\r
moduleversion: tversion;\r\r
compilationdate: coded_date;\r\r
compilationtime: coded_time;\r\r
$if target = rc3502\r\r
compilerid : compilerid_type;\r\r
$endif\r\r
end;\r\r
\r\r
descriptor_segment =\r\r
record\r\r
descriptor_length,\r\r
no_of_pages ,\r\r
pagesize ,\r\r
last_page_length ,\r\r
kind : integer;\r\r
name : alfa;\r\r
entry_point : addr;\r\r
exception_point : addr;\r\r
default_appetite ,\r\r
last_param_offset: integer;\r\r
source_date : coded_date;\r\r
source_time : coded_time;\r\r
version : integer;\r\r
compilerid : compilerid_type;\r\r
no_of_params : integer;\r\r
end;\r\r
\r\r
\r\r
$if systemenv = 0\r\r
(******************************)\r\r
(* shielded type declarations in std environment for the compiler *)\r\r
(******************************)\r\r
\r\r
mailbox_ = \r\r
record\r\r
? : addr; -- message_headers or register_sets\r\r
? : ^ mailbox; -- used by remove\r\r
end;\r\r
\r\r
pool_ = \r\r
record\r\r
? : addr; -- message_headers or register_sets\r\r
? : ^ integer; -- ^ pool used by remove\r\r
end;\r\r
\r\r
\r\r
process_ =\r\r
record\r\r
proc : ^ integer; -- address of process descriptor\r\r
next : ^ integer; -- ^ process used by remove\r\r
end;\r\r
\r\r
reference_ =\r\r
record\r\r
? : byte; -- locked : byte;\r\r
? : ^ integer; -- header : ^ message_header;\r\r
? : ^ integer; -- next : ^ reference;\r\r
end;\r\r
\r\r
chain_ =\r\r
record\r\r
? : ^ integer; -- current chain_element\r\r
? : ^ integer; -- start chain_element\r\r
? : 0..maxint; -- no of chain_elements in chain\r\r
end;\r\r
\r\r
port_ =\r\r
record\r\r
? : byte;\r\r
? : ^ mailbox;\r\r
? : mailbox;\r\r
? : mailbox;\r\r
? : mailbox;\r\r
end;\r\r
\r\r
program_descriptor = -- the "type" of a program\r\r
record\r\r
-- used by link and unlink\r\r
? : integer; -- no of incarnations of this program\r\r
? : ^ integer; -- address of formal parameters\r\r
? : integer; -- 0: unlinked\r\r
-- 1: internal linked\r\r
-- 2: external linked\r\r
? : ^ integer; -- pointer to descriptorsegment\r\r
-- if external linked\r\r
-- pointer to program_inf\r\r
-- if internal linked\r\r
? : alfa;\r\r
? : ^ integer; -- addr program_descriptor used by remove\r\r
end;\r\r
\r\r
$endif\r\r
\r\r
$if systemenv = 1\r\r
{----------\r
(******************************)\r\r
(* shielded type declarations in system environment *)\r\r
(******************************)\r\r
\r\r
\r\r
adr = \r\r
record\r\r
base : base_type;\r\r
disp : integer\r\r
end;\r\r
\r\r
mailbox_ = \r\r
record\r\r
mbx : addr; -- message_headers or register_sets\r\r
next : ^ mailbox; -- used by remove\r\r
end;\r\r
\r\r
pool_ = \r\r
record\r\r
mbx : addr; -- message_headers or register_sets\r\r
next : ^ pool; -- used by remove\r\r
end;\r\r
\r\r
process_descriptor_p;\r\r
process_ =\r\r
record\r\r
proc : process_descriptor_p; -- address of process descriptor\r\r
next : ^ process; -- used by remove\r\r
end;\r\r
\r\r
message_header_p;\r\r
message_header =\r\r
record\r\r
nulbyte : byte;\r\r
chain : message_header_p;\r\r
u1 : byte;\r\r
u2 : byte;\r\r
u3 : byte;\r\r
u4 : byte;\r\r
messagekind : integer;\r\r
size : integer;\r\r
start : addr;\r\r
owner : ^ mailbox;\r\r
answer : ^ mailbox;\r\r
msgchain : message_header_p;\r\r
stackchain : message_header_p;\r\r
connection_index : byte;\r\r
credit_count : byte;\r\r
reason : byte;\r\r
event_kind : byte;\r\r
end;\r\r
message_header_p = ^ message_header;\r\r
\r\r
reference_ =\r\r
record\r\r
locked : byte;\r\r
header : ^ message_header;\r\r
next : ^ reference;\r\r
end;\r\r
\r\r
chain_element_p;\r\r
chain_element =\r\r
record\r\r
r : reference;\r\r
up : chain_element_p;\r\r
down : chain_element_p;\r\r
end;\r\r
chain_element_p = ^ chain_element;\r\r
\r\r
chain_ =\r\r
record\r\r
cur : ^ chain_element; -- current chain_element\r\r
start : ^ chain_element; -- start chain_element\r\r
length : 0..maxint; -- no of chain_elements in chain\r\r
end;\r\r
\r\r
port_ =\r\r
record\r\r
index_limit : byte;\r\r
imc_box : ^ mailbox;\r\r
port_active : mailbox;\r\r
port_ready : mailbox;\r\r
port_answer : mailbox;\r\r
end;\r\r
\r\r
shared_descr = -- controls access to a shared variable\r\r
record\r\r
r : reference; -- message containing shared variable\r\r
object : ^ mailbox; -- synchs access to shared variable\r\r
end;\r\r
\r\r
program_inf =\r\r
record\r\r
entry_point : adr;\r\r
exception_point : adr;\r\r
default_appetite : integer;\r\r
last_param_offset : integer\r\r
end;\r\r
\r\r
const\r\r
maxparams = 30; (* must match pass5 crosslink values !!! *)\r\r
\r\r
type\r\r
\r\r
param_descr =\r\r
record\r\r
kind ,\r\r
size : integer;\r\r
end;\r\r
\r\r
param_array = array (1..maxparams) of param_descr;\r\r
\r\r
param_record =\r\r
record\r\r
no_of_params : integer;\r\r
params : param_array;\r\r
end;\r\r
\r\r
ext_linktable_entry =\r\r
record\r\r
name : alfa;\r\r
params : param_record;\r\r
end;\r\r
\r\r
\r\r
program_descriptor_p;\r\r
program_descriptor = -- the "type" of a program\r\r
record\r\r
-- used by link and unlink\r\r
count : integer; -- no of incarnations of this program\r\r
paramptr : ^ param_record; -- address of formal parameters\r\r
state : integer; -- 0: unlinked\r\r
-- 1: internal linked\r\r
-- 2: external linked\r\r
programinf : ^ descriptor_segment; -- pointer to descriptorsegment\r\r
-- if external linked\r\r
-- pointer to program_inf\r\r
-- if internal linked\r\r
prgname : alfa;\r\r
next : program_descriptor_p; -- used by remove\r\r
end;\r\r
program_descriptor_p = ^ program_descriptor;\r\r
\r\r
programrec = -- used by create\r\r
record\r\r
programref : ^ program_descriptor;\r\r
firstparam : ^ byte;\r\r
size_of_params : integer;\r\r
end;\r\r
\r\r
mbxtype = (deallocatormbx,linkermbx,stopmbx,allocmbx,exceptionmbx,\r\r
opmbx,restart_mbx,stop_msg,writerammbx,addrmbx,testoutputmbx,commonpool,\r\r
monitormbx,printstatmbx,timermbx,iotimermbx,_adammbx,\r\r
timerbase,exceptionstack,monitorstack,\r\r
timerstack,allocatorstack,linkerstack,operatorstack);\r\r
\r\r
secret_vector = array (mbxtype) of \r\r
record\r\r
nulbyte : byte;\r\r
p : ^ mailbox;\r\r
end;\r\r
\r\r
\r\r
process_descriptor =\r\r
record\r\r
-- the process descriptor appearing as the first part of global frame\r\r
timer : integer;\r\r
level : byte;\r\r
delaychain : process_descriptor_p;\r\r
exceptioncode : integer;\r\r
exic : addr;\r\r
exceptionpoint : addr;\r\r
maxstack : integer;\r\r
regset : integer;\r\r
mregset : integer;\r\r
procstate : integer;\r\r
programref : ^ program_descriptor; -- in fathers stack\r\r
mbxchain : ^ mailbox;\r\r
refchain : ^ reference;\r\r
processchain : ^ process;\r\r
msgchain : ^ message_header;\r\r
programchain : ^ program_descriptor; -- in own stack\r\r
workmbx : mailbox;\r\r
secretpointer : ^ secret_vector;\r\r
workref : reference;\r\r
plinetable : ^ byte;\r\r
procname : alfa;\r\r
father : process_descriptor_p;\r\r
processref : ^ process; (* in fathers stack *)\r\r
end;\r\r
process_descriptor_p = ^ process_descriptor;\r\r
\r\r
----------}\r
$endif\r\r
\r\r
\r\r
(*********************************)\r\r
(***** predefined routines *****)\r\r
(*********************************)\r\r
\r\r
\r\r
function abs(n: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure alloc( var r: reference; var p: pool; var ra: mailbox);\r\r
external;\r\r
\r\r
function allocdelay(var r: reference; var p:pool; var ra: mailbox;\r\r
ms: integer): activation;\r\r
external;\r\r
\r\r
function allocmempool(var p: pool; no_of_bufs, bufsize: integer;\r\r
mem: mem_type): integer;\r\r
external;\r\r
\r\r
function allocpool=allocpool_rc\r\r
(var p: pool; no_of_bufs, bufsize: integer): integer;\r\r
external;\r\r
\r\r
procedure break(var proc: process; fault: integer);\r\r
external;\r\r
\r\r
function bufcount(var r: reference): integer;\r\r
external;\r\r
\r\r
function bufsize(var r: rtype ): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function bytecount(var r: rtype ): integer;\r\r
external;\r\r
\r\r
procedure chaindequeue(var ref: reference; var ch: chain);\r\r
external;\r\r
\r\r
procedure chaindown(var ch: chain);\r\r
external;\r\r
\r\r
procedure chainenqueue(var ref: reference; var ch: chain);\r\r
external;\r\r
\r\r
function chainlength(var ch: chain): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure chainreset(var ch: chain);\r\r
openroutine;\r\r
\r\r
\r\r
procedure chainstart(var ch: chain);\r\r
openroutine;\r\r
\r\r
\r\r
procedure chainup(var ch: chain);\r\r
external;\r\r
\r\r
function ord(v: btype): integer; \r\r
openroutine;\r\r
\r\r
\r\r
function ord(v: wtype): integer; openroutine;\r\r
function chr(v: byte): char;\r\r
openroutine;\r\r
\r\r
\r\r
\r\r
function create(inspect incname: string; var prog: program_descriptor;\r\r
var pr: process; size: integer; prio: integer): create_result;\r\r
external;\r\r
\r\r
function creditcount(var r: reference): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure dec(var v: byte);\r\r
openroutine;\r\r
\r\r
\r\r
procedure dec(var v: integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure delay(ms: integer);\r\r
openroutine;\r\r
\r\r
\r\r
function eventkind(var r: rtype): event_type;\r\r
openroutine;\r\r
\r\r
\r\r
procedure exception(c: integer);\r\r
external;\r\r
\r\r
function hometest(var r: rtype; var p: pool): boolean;\r\r
external;\r\r
\r\r
procedure inc(var v: byte);\r\r
openroutine;\r\r
\r\r
\r\r
procedure inc(var v:integer);\r\r
openroutine;\r\r
\r\r
\r\r
function index(var r:reference): integer;\r\r
openroutine;\r\r
\r\r
\r\r
\r\r
function link(inspect incname: string;var prog: program_descriptor):\r\r
link_result;\r\r
external;\r\r
\r\r
function locked(var m:mailbox): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
function locktest(var r: reference): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
procedure new(var p: ptype); external;\r\r
\r\r
function nil(var p:ptype ): boolean; openroutine;\r\r
function nil(var p:process): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
function nil(var p:reference): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
function offset(var r:rtype ): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function open(var m:mailbox): boolean; openroutine;\r\r
function openpool(var p: pool): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
function passive(var m:mailbox): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
procedure pop(var b,s: reference);\r\r
openroutine;\r\r
\r\r
\r\r
function pred(v: btype): btype; openroutine;\r\r
function pred(v: wtype): wtype;\r\r
openroutine;\r\r
\r\r
\r\r
procedure push(var b,s: reference);\r\r
openroutine;\r\r
\r\r
\r\r
function reason(var r:reference): reason_type;\r\r
openroutine;\r\r
\r\r
\r\r
procedure release(var r: reference);\r\r
openroutine;\r\r
\r\r
\r\r
function releasepool(var p:pool; bufs: integer): integer;\r\r
external;\r\r
\r\r
procedure remove(var pr: process);\r\r
external;\r\r
\r\r
procedure resetevent(var r: rtype);\r\r
openroutine;\r\r
\r\r
\r\r
procedure resume(var pr: process);\r\r
external;\r\r
\r\r
procedure return(var r:reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure setbytecount(var r: rtype ; v: integer);\r\r
external;\r\r
\r\r
procedure setoffset=setoffset_rc(var r: rtype ; v: integer);\r\r
external;\r\r
\r\r
procedure settop=settop____rc(var r: rtype ; v: integer);\r\r
external;\r\r
\r\r
procedure setu1(var r: rtype ; v: byte);\r\r
external;\r\r
\r\r
procedure setu2(var r: rtype ; v: byte);\r\r
external;\r\r
\r\r
procedure setu3(var r: rtype ; v: byte);\r\r
external;\r\r
\r\r
procedure setu4(var r: rtype ; v: byte);\r\r
external;\r\r
\r\r
procedure signal(var r: reference; var m:mailbox);\r\r
openroutine;\r\r
\r\r
\r\r
function stackdepth(var r:reference ): integer;\r\r
external;\r\r
\r\r
procedure start(var pr: process; prio: integer);\r\r
external;\r\r
\r\r
procedure stop(var p: process);\r\r
external;\r\r
\r\r
function succ(v:btype): btype; openroutine;\r\r
function succ(v:wtype): wtype;\r\r
openroutine;\r\r
\r\r
\r\r
procedure tofrom=tofrom____rc(var toref: reference; toindex: integer;\r\r
var fromref: reference; fromindex: integer;\r\r
bytes: integer );\r\r
external;\r\r
\r\r
function top(var r:rtype ): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure trace = exception(f: integer);\r\r
external;\r\r
\r\r
procedure stacktrace = exception(f: integer);\r\r
external;\r\r
\r\r
function unlink(var prog: program_descriptor): integer;\r\r
external;\r\r
\r\r
function u1(var r:rtype ): byte;\r\r
openroutine;\r\r
\r\r
\r\r
function u2(var r:rtype ): byte;\r\r
openroutine;\r\r
\r\r
\r\r
function u3(var r:rtype ): byte;\r\r
openroutine;\r\r
\r\r
\r\r
function u4(var r:rtype ): byte;\r\r
openroutine;\r\r
\r\r
\r\r
procedure wait( var r: reference; var m: mailbox);\r\r
openroutine;\r\r
\r\r
\r\r
function waitdelay(var r: reference; var m: mailbox;\r\r
ms: integer): activation;\r\r
external;\r\r
\r\r
procedure closeport(var p: port);\r\r
external;\r\r
\r\r
procedure connect(var p:port; index:1..maxint; var compl, disc: reference;\r\r
inspect remote_name:string; service: conn_service);\r\r
external;\r\r
\r\r
procedure disconnect(var p:port; index:1..maxint);\r\r
external;\r\r
\r\r
procedure getconnection(var p:port; index:1..maxint; var compl, disc:reference);\r\r
external;\r\r
\r\r
procedure getcredit(var p:port; index:1..maxint; var credbuf: reference);\r\r
external;\r\r
\r\r
procedure getreset(var p:port; index:1..maxint; var indic: reference);\r\r
external;\r\r
\r\r
function maxconnections:integer;\r\r
external;\r\r
\r\r
procedure openport(var p:port; var closebuf: reference;\r\r
inspect name:string; scope: scope_type;\r\r
no_of_cons: 0..maxint; cntrl: control_type);\r\r
external;\r\r
\r\r
procedure receive(var p:port; index:1..maxint; var databuf: reference);\r\r
external;\r\r
\r\r
procedure receiveall(var p:port; var databuf: reference);\r\r
external;\r\r
\r\r
procedure reset(var p:port; index:1..maxint; var compl: reference);\r\r
external;\r\r
\r\r
procedure send(var p:port; index:1..maxint; var databuf: reference);\r\r
external;\r\r
\r\r
\r\r
(* implementation dependent standard routines and types*)\r\r
\r\r
type\r\r
\r\r
lookup_descriptor_segment =\r\r
record\r\r
name : alfa;\r\r
descriptor_length,\r\r
no_of_pages ,\r\r
pagesize ,\r\r
last_page_length ,\r\r
kind : integer;\r\r
default_appetite ,\r\r
last_param_offset,\r\r
no_of_params : integer;\r\r
date : coded_date;\r\r
time : coded_time;\r\r
source_date : coded_date;\r\r
source_time : coded_time;\r\r
version : integer;\r\r
-- $ if target = rc3502\r\r
-- compilerid : compilerid_type; -- later ?\r\r
-- $ endif\r\r
end;\r\r
\r\r
(* *)\r\r
\r\r
function alias( var p: port; inspect name: string ): boolean;\r\r
external;\r\r
\r\r
function clock_difference( t1, t2: clocktype ): coded_inc;\r\r
external;\r\r
\r\r
function clock_increment( t: clocktype; inc: coded_inc ): clocktype;\r\r
external;\r\r
\r\r
function clock_less_than( t1, t2: clocktype ): boolean;\r\r
external;\r\r
\r\r
function crc16( op1, op2 : integer ): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function crc16buf( var r: reference;\r\r
frombyte, tobyte : integer;\r\r
quotient, startvalue : integer ): integer;\r\r
external;\r\r
\r\r
function deletemailbox(inspect mbx_name: string): integer;\r\r
external;\r\r
\r\r
function getclock: clocktype;\r\r
external;\r\r
\r\r
function imcpresent: boolean;\r\r
external;\r\r
\r\r
procedure getservers( var r: reference; inspect mask: string );\r\r
external;\r\r
\r\r
function namemailbox(var m: mailbox; inspect mbx_name: string): integer;\r\r
external;\r\r
\r\r
function ownname(var name:string): byte;\r\r
external;\r\r
\r\r
function ownprogramname(var name:string): byte;\r\r
external;\r\r
\r\r
procedure ownversion(var myversion: tmoduleversion);\r\r
external;\r\r
\r\r
function searchmailbox(inspect mbx_name: string): ^mailbox;\r\r
external;\r\r
\r\r
procedure sendadam=sendadam__rc(var ref: reference );\r\r
external;\r\r
\r\r
procedure sendlinker=sendlinkerrc(var ref: reference );\r\r
external;\r\r
\r\r
procedure sendtimer=sendtimer_rc(var ref: reference );\r\r
external;\r\r
\r\r
procedure setownname(inspect name: string );\r\r
external;\r\r
\r\r
procedure setpriority(priority : integer);\r\r
external;\r\r
\r\r
function swap(n: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
(* implementation demendent open routines *)\r\r
\r\r
--procedure breakpoint;\r\r
--external;\r\r
\r\r
procedure definetimer( on: boolean );\r\r
external;\r\r
\r\r
--function equalhome(var a: rtype ; var b: rtype ): boolean;\r\r
--external;\r\r
\r\r
--function homeless(var r: rtype ): boolean;\r\r
--external;\r\r
\r\r
function madd( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function mmul( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function msub( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function rotate( a, shl: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function uadd( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function udiv( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function ult( a, b: integer): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
function umod( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function umul( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function usub( a, b: integer): integer;\r\r
openroutine;\r\r
\r\r
\r\r
\r\r
(* input-output interrupt routines *)\r\r
procedure clearinterrupt;\r\r
openroutine;\r\r
\r\r
\r\r
procedure control(c: integer; var chmsg: reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure controlclr(c: integer);\r\r
openroutine;\r\r
\r\r
\r\r
function ctrwaitid(c: integer; ms: integer): activation;\r\r
openroutine;\r\r
\r\r
\r\r
function ctrwaitim(c: integer; var r: reference; var m: mailbox): activation;\r\r
openroutine;\r\r
\r\r
\r\r
function ctrwaitimd(c: integer; var r: reference; var m: mailbox;\r\r
ms: integer ): activation;\r\r
openroutine;\r\r
\r\r
\r\r
function eoi : boolean;\r\r
openroutine;\r\r
\r\r
\r\r
type\r\r
bufparamtype = array ( 1..8 ) of byte;\r\r
\r\r
procedure getbufparam(var bufparam : bufparamtype;\r\r
first, last: integer; var msg: reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure inbyteblock( var next : integer;\r\r
first, last: integer;\r\r
var msg : reference );\r\r
openroutine;\r\r
\r\r
\r\r
procedure inword(var word: integer; var chmsg: reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure inwordblock( var next : integer;\r\r
first, last: integer;\r\r
var msg : reference );\r\r
openroutine;\r\r
\r\r
\r\r
procedure inwordclr(var word: integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure iowbwc(bufparam : bufparamtype);\r\r
openroutine;\r\r
\r\r
\r\r
function messagekind( var r: reference ): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure outbyteblock( var next : integer;\r\r
first, last: integer;\r\r
var msg : reference );\r\r
openroutine;\r\r
\r\r
\r\r
procedure outword(word : integer; var chmsg: reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure outwordblock( var next : integer;\r\r
first, last: integer;\r\r
var msg : reference );\r\r
openroutine;\r\r
\r\r
\r\r
procedure outwordclr(word : integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure returnx (var r:reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure sense(var status: integer; status_out : integer;\r\r
var chmsg: reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure senseclr(var status: integer; status_out : integer;\r\r
compare, mask: integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure setinterrupt(var ch : reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure signalx(var r: reference; var m:mailbox);\r\r
openroutine;\r\r
\r\r
\r\r
function timedout: boolean;\r\r
openroutine;\r\r
\r\r
\r\r
procedure waiti;\r\r
openroutine;\r\r
\r\r
\r\r
function waitid( msecs: integer ): activation;\r\r
openroutine;\r\r
\r\r
\r\r
function waitim( var r: reference; var m : mailbox ): activation;\r\r
openroutine;\r\r
\r\r
\r\r
function waitimd ( var r: reference; var m : mailbox;\r\r
msecs : integer ): activation;\r\r
openroutine;\r\r
\r\r
\r\r
\r\r
$if systemenv = 1\r\r
{----------\r
---------------------------------------------------------------\r\r
(* extra routines for imc *)\r\r
---------------------------------------------------------------\r\r
\r\r
procedure excptcall ( errno: integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure setcreditcount ( var r:reference; credits: byte);\r\r
openroutine;\r\r
\r\r
\r\r
procedure seteventkind ( var r:reference; event: event_type);\r\r
openroutine;\r\r
\r\r
\r\r
procedure setindex ( var r:reference; index: byte);\r\r
openroutine;\r\r
\r\r
\r\r
procedure setreason ( var r:reference; reason: reason_type);\r\r
openroutine;\r\r
\r\r
\r\r
----------------------------------------\r\r
(* other useful routines *)\r\r
----------------------------------------\r\r
\r\r
const\r\r
\r\r
heap_buffersize = 256; (* bytes , default size of user part in heapbuffer *)\r\r
\r\r
ok = 0;\r\r
overlap = 1;\r\r
no_resources = 2;\r\r
not_found = 1;\r\r
\r\r
type\r\r
\r\r
name_entry_p;\r\r
name_entry = (* record in the list of cataloged mailbox names *)\r\r
record\r\r
next_name_entry : name_entry_p;\r\r
mbxptr : ^ mailbox; (* the cataloged mailbox *)\r\r
name : alfa; (* the mailbox is cataloged under this name *)\r\r
end;\r\r
name_entry_p = ^ name_entry;\r\r
\r\r
const\r\r
\r\r
name_entry_size = typesize (name_entry);\r\r
\r\r
type\r\r
\r\r
call_remote_zone =\r\r
record\r\r
r : reference;\r\r
remote : ^ mailbox;\r\r
p : pool;\r\r
m : mailbox;\r\r
name : alfa;\r\r
end;\r\r
\r\r
type\r\r
\r\r
heap_head_p;\r\r
heap_head = (* system part of a heap buffer *)\r\r
record\r\r
size : integer; (* words , used by allocator *)\r\r
next_heap_head : heap_head_p;\r\r
next_free : ^ byte; (* first free byte in this buffer *)\r\r
no_of_free_bytes : integer; (* in this buffer *)\r\r
end;\r\r
heap_head_p = ^ heap_head;\r\r
\r\r
const\r\r
\r\r
heap_head_size = typesize (heap_head);\r\r
default_size = heap_head_size + heap_buffersize;\r\r
\r\r
type\r\r
\r\r
heap_root = (* record pointed out by the field 'own.heap' *) \r\r
record\r\r
size : integer; (* words , used by allocator *)\r\r
first_heap_head : ^ heap_head; (* queue of heap buffers *)\r\r
last_heap_head : ^ heap_head;\r\r
name_catalog : ^ name_entry; (* mailbox name list *)\r\r
free_names : ^ name_entry; (* free nodes for name_catalog *)\r\r
cur_catalog : ^ byte; --fs_catalog_connection; (* current catalog *)\r\r
lfparammbx : ^ mailbox; (* param resource mailbox *)\r\r
lf3502mbx : ^ mailbox; (* mainmailbox for lf3502 access methode *)\r\r
remote_rec : ^ call_remote_zone; (* record for call_remote params *)\r\r
lf_mask : set of 0..15; --lf_exceptions; \r\r
heap_refchain : ^ reference;\r\r
free_chain_elements : ^ chain_element;\r\r
end;\r\r
\r\r
const\r\r
\r\r
heap_root_size = typesize (heap_root);\r\r
\r\r
new_appetite = 22 + 14; (* words *)\r\r
\r\r
procedure _initchainrc (ch : ^ chain);\r\r
openroutine;\r\r
\r\r
\r\r
function addptr1 ( anyptr: ^ integer; incr: integer): ^ integer; openroutine;\r\r
function addptr2 ( anyptr: ^ process_descriptor; incr: integer): ^ process_descriptor; openroutine;\r\r
function addptr3 ( anyptr: ^ descriptor_segment; incr: integer): ^ descriptor_segment; openroutine;\r\r
function addptr4 ( anyptr: ^ byte; incr: integer): ^ byte; openroutine;\r\r
function addptr5 ( anyptr: ^ heap_head; incr: integer): ^ byte; openroutine;\r\r
function addptr6 ( anyptr: ^ byte; incr: integer): ^ mailbox; openroutine;\r\r
function addptr7 ( anyptr: ^ descriptor_segment; incr: integer): ^ program_inf; openroutine;\r\r
function addptr8 ( anyptr: ^ process_descriptor; incr: integer): ^ integer; openroutine;\r\r
function addptr9 ( anyptr: ^ descriptor_segment; incr: integer): ^ addr;\r\r
openroutine;\r\r
\r\r
\r\r
function addrptr1 ( anyptr: ^ process_descriptor): addr; openroutine;\r\r
function addrptr2 ( anyptr: ^ program_descriptor): addr; openroutine;\r\r
function addrptr3 ( anyptr: ^ heap_root): addr; openroutine;\r\r
function addrptr4 ( anyptr: ^ heap_head): addr; openroutine;\r\r
function addrptr5 ( anyptr: ^ byte): addr;\r\r
openroutine;\r\r
\r\r
\r\r
procedure balloc;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bcheck;\r\r
openroutine;\r\r
\r\r
\r\r
function bcrc16buffer (frombyte, tobyte: integer; var r: reference): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function bhometest (var p : pool; var r : reference): boolean;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bregion___rc;\r\r
openroutine;\r\r
\r\r
\r\r
procedure breg_exit_rc;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetfirst;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetlast;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetnext;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetownname (inspect n: alfa);\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetu1;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetu2;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetu3;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bsetu4;\r\r
openroutine;\r\r
\r\r
\r\r
procedure btofrom;\r\r
openroutine;\r\r
\r\r
\r\r
type\r\r
artype = array (1..maxint) of byte;\r\r
arptr = ^ artype;\r\r
\r\r
function bufstart (var r : reference): ^ artype;\r\r
openroutine;\r\r
\r\r
\r\r
procedure bunchainref;\r\r
openroutine;\r\r
\r\r
\r\r
function bwaitdelay(var r: reference; var m: mailbox;\r\r
ms: integer): activation;\r\r
openroutine;\r\r
\r\r
\r\r
function carry : boolean;\r\r
openroutine;\r\r
\r\r
\r\r
function first (var r : reference): integer;\r\r
openroutine;\r\r
\r\r
\r\r
function getheap (var proc : process_descriptor) : ^ heap_root;\r\r
openroutine;\r\r
\r\r
\r\r
procedure getinteger ( var dest: integer; srcaddr: addr);\r\r
openroutine;\r\r
\r\r
\r\r
procedure getlfgf ( var lf, gf: addr);\r\r
openroutine;\r\r
\r\r
\r\r
function getown : ^ process_descriptor;\r\r
openroutine;\r\r
\r\r
\r\r
procedure getregister ( var dest: integer; index: integer);\r\r
openroutine;\r\r
\r\r
\r\r
function last (var r : reference): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure linkmessage (var r : reference);\r\r
openroutine;\r\r
\r\r
\r\r
procedure movebytes1 (dest: ^ process_descriptor; source: ^ byte; bytes: integer); openroutine;\r\r
procedure movebytes2 (dest, source: ^ byte; bytes : integer);\r\r
openroutine;\r\r
\r\r
\r\r
function next (var r : reference): integer;\r\r
openroutine;\r\r
\r\r
\r\r
procedure pexit3;\r\r
openroutine;\r\r
\r\r
\r\r
function ptr ( var a: integer): ^ process_descriptor;\r\r
openroutine;\r\r
\r\r
\r\r
function ptraddr1 (a : addr) : ^ reference; openroutine;\r\r
function ptraddr2 (a : addr) : ^ process; openroutine;\r\r
function ptraddr3 (a : addr) : ^ mailbox; openroutine;\r\r
function ptraddr4 (a : addr) : ^ program_descriptor; openroutine;\r\r
function ptraddr5 (a : addr) : ^ message_header; openroutine;\r\r
function ptraddr6 (a : addr) : ^ process_descriptor; openroutine;\r\r
function ptraddr7 (a : addr) : ^ clocktype; openroutine;\r\r
function ptraddr8 (a : addr) : ^ byte; openroutine;\r\r
function ptraddr9 (a : addr) : ^ heap_root; openroutine;\r\r
function ptraddr10(a : addr) : ^ heap_head;\r\r
openroutine;\r\r
\r\r
\r\r
procedure readbyte ( var dest, src: byte);\r\r
openroutine;\r\r
\r\r
\r\r
procedure readram ( var dest: byte; ramindex: integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure readword ( var dest, src: integer);\r\r
openroutine;\r\r
\r\r
\r\r
function refmailbox ( var m: mailbox): ^ mailbox;\r\r
openroutine;\r\r
\r\r
\r\r
function refpool (var p : pool): ^ mailbox;\r\r
openroutine;\r\r
\r\r
\r\r
function refprocess (var proc : process): ^ process;\r\r
openroutine;\r\r
\r\r
\r\r
procedure selectlevel (level : integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure sensembx ( var r: reference; var m: mailbox);\r\r
openroutine;\r\r
\r\r
\r\r
procedure setheap (p : ^ heap_root);\r\r
openroutine;\r\r
\r\r
\r\r
procedure writeram ( ramindex, data: integer);\r\r
openroutine;\r\r
\r\r
\r\r
procedure writeramclr ( ramindex, data: integer);\r\r
openroutine;\r\r
\r\r
\r\r
----------}\r
$endif\r\r
.\r\r