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