|
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: 32608 (0x7f60)
Types: TextFile
Names: »RTPSTD35.SRC«
└─⟦d5707feda⟧ Bits:30010512 DVBS1.SW2114.src.2.14-3 SW2114 REAL #3/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »RTPSTD\SYS35\RTPSTD35.SRC«
$listoff\r
stdenv;\r
(*--------------------------------------------\r
--\r
-- System Standard Environment for RTP\r
--\r
-- 87.09.27 TOG First version.\r
-- 92.06.04 HEJ Type bufparamtype added.\r
-- 92.06.12 HEJ A number of open routines added ( eg. for IMC ).\r
-- - Type compilerid_type\r
-- 92.06.19 HEJ The type of index changed: byte -> integer,\r
-- - parameter of locktest changed: mailbox -> reference.\r
-- 92.06.29 HEJ Like Telebit: add nl and alfalength to stdenv.\r
-- 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
-- 92.09.01 HEJ Fields in system objects are made unused by ?,\r
-- switch systemenv used,\r
-- addr, break_by_father, returnx, and signalx made public.\r
--\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 and 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 and 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
BEGIN\r
abs 2 35 2 34 2\r
END;\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
BEGIN\r
bufsize___rc 2 35 2 13 7\r
END;\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
BEGIN\r
chainlength 2 35 2 41 8\r
END;\r
\r
PROCEDURE chainreset(VAR ch: chain);\r
BEGIN\r
chainreset 1 41 8\r
END;\r
\r
PROCEDURE chainstart(VAR ch: chain);\r
BEGIN\r
chainstart 1 41 8\r
END;\r
\r
PROCEDURE chainup(VAR ch: chain);\r
EXTERNAL;\r
\r
FUNCTION ord(v: btype): integer; \r
BEGIN\r
ord 0\r
END;\r
\r
FUNCTION ord(v: wtype): integer; AND\r
FUNCTION chr(v: byte): char;\r
BEGIN\r
chr 0\r
END;\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
BEGIN\r
creditcount 2 35 2 13 7\r
END;\r
\r
PROCEDURE dec(VAR v: byte);\r
BEGIN\r
_dec_byte_rc 1 33 1\r
END;\r
\r
PROCEDURE dec(VAR v: integer);\r
BEGIN\r
dec 1 33 2\r
END;\r
\r
PROCEDURE delay(ms: integer);\r
BEGIN\r
delay 1 34 2\r
END;\r
\r
FUNCTION eventkind(VAR r: rtype): event_type;\r
BEGIN\r
eventkind 2 35 1 13 7\r
END;\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
BEGIN\r
_inc_byte_rc 1 33 1\r
END;\r
\r
PROCEDURE inc(VAR v:integer);\r
BEGIN\r
inc 1 33 2\r
END;\r
\r
FUNCTION index(VAR r:reference): integer;\r
BEGIN\r
index 2 35 2 13 7\r
END;\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
BEGIN\r
locked 2 35 1 9 7\r
END;\r
\r
FUNCTION locktest(VAR r: reference): boolean;\r
BEGIN\r
locktest 2 35 1 13 7\r
END;\r
\r
PROCEDURE new(VAR p: ptype); EXTERNAL;\r
\r
FUNCTION nil(VAR p:ptype ): boolean; AND\r
FUNCTION nil(VAR p:process): boolean;\r
BEGIN\r
nil 2 35 1 13 7\r
END;\r
\r
FUNCTION nil(VAR p:reference): boolean;\r
BEGIN\r
nilref 2 35 1 13 7\r
END;\r
\r
FUNCTION offset(VAR r:rtype ): integer;\r
BEGIN\r
offset____rc 2 35 2 13 7\r
END;\r
\r
FUNCTION open(VAR m:mailbox): boolean; AND\r
FUNCTION openpool(VAR p: pool): boolean;\r
BEGIN\r
open 2 35 1 9 7\r
END;\r
\r
FUNCTION passive(VAR m:mailbox): boolean;\r
BEGIN\r
passive 2 35 1 9 7\r
END;\r
\r
PROCEDURE pop(VAR b,s: reference);\r
BEGIN\r
pop 2 13 7 13 7\r
END;\r
\r
FUNCTION pred(v: btype): btype; AND\r
FUNCTION pred(v: wtype): wtype;\r
BEGIN\r
pred 3 35 2 34 2 34 2\r
END;\r
\r
PROCEDURE push(VAR b,s: reference);\r
BEGIN\r
push 2 13 7 13 7\r
END;\r
\r
FUNCTION reason(VAR r:reference): reason_type;\r
BEGIN\r
reason 2 35 1 13 7\r
END;\r
\r
PROCEDURE release(VAR r: reference);\r
BEGIN\r
release 1 13 7\r
END;\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
BEGIN\r
resetevent 1 13 7\r
END;\r
\r
PROCEDURE resume(VAR pr: process);\r
EXTERNAL;\r
\r
PROCEDURE return(VAR r:reference);\r
BEGIN\r
return 1 13 7\r
END;\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
BEGIN\r
signal 2 13 7 9 7\r
END;\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; AND\r
FUNCTION succ(v:wtype): wtype;\r
BEGIN\r
succ 3 35 2 34 2 34 2\r
END;\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
BEGIN\r
top_______rc 2 35 2 13 7\r
END;\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
BEGIN\r
u1 2 35 1 13 7\r
END;\r
\r
FUNCTION u2(VAR r:rtype ): byte;\r
BEGIN\r
u2 2 35 1 13 7\r
END;\r
\r
FUNCTION u3(VAR r:rtype ): byte;\r
BEGIN\r
u3 2 35 1 13 7\r
END;\r
\r
FUNCTION u4(VAR r:rtype ): byte;\r
BEGIN\r
u4 2 35 1 13 7\r
END;\r
\r
PROCEDURE wait( VAR r: reference; VAR m: mailbox);\r
BEGIN\r
wait 2 13 7 9 7\r
END;\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
BEGIN\r
crc16 3 35 2 34 2 34 2\r
END;\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
BEGIN\r
swap 2 35 2 34 2\r
END;\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
BEGIN\r
madd 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION mmul( a, b: integer): integer;\r
BEGIN\r
mmul 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION msub( a, b: integer): integer;\r
BEGIN\r
msub 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION rotate( a, shl: integer): integer;\r
BEGIN\r
rotate 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION uadd( a, b: integer): integer;\r
BEGIN\r
uadd 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION udiv( a, b: integer): integer;\r
BEGIN\r
udiv 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION ult( a, b: integer): boolean;\r
BEGIN\r
ult 3 35 1 34 2 34 2\r
END;\r
\r
FUNCTION umod( a, b: integer): integer;\r
BEGIN\r
umod 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION umul( a, b: integer): integer;\r
BEGIN\r
umul 3 35 2 34 2 34 2\r
END;\r
\r
FUNCTION usub( a, b: integer): integer;\r
BEGIN\r
usub 3 35 2 34 2 34 2\r
END;\r
\r
\r
(* INPUT-OUTPUT and INTERRUPT routines *)\r
PROCEDURE clearinterrupt;\r
BEGIN\r
clearinterru 0\r
END;\r
\r
PROCEDURE control(c: integer; VAR chmsg: reference);\r
BEGIN\r
control 2 34 2 13 7\r
END;\r
\r
PROCEDURE controlclr(c: integer);\r
BEGIN\r
controlclr 1 34 2\r
END;\r
\r
FUNCTION ctrwaitid(c: integer; ms: integer): activation;\r
BEGIN\r
ctrwaitid 3 35 1 34 2 34 2\r
END;\r
\r
FUNCTION ctrwaitim(c: integer; VAR r: reference; VAR m: mailbox): activation;\r
BEGIN\r
ctrwaitim 4 35 1 34 2 13 7 9 7\r
END;\r
\r
FUNCTION ctrwaitimd(c: integer; VAR r: reference; VAR m: mailbox;\r
ms: integer ): activation;\r
BEGIN\r
ctrwaitimd 5 35 1 34 2 13 7 9 7 34 2\r
END;\r
\r
FUNCTION eoi : boolean;\r
BEGIN\r
eoi 1 35 1\r
END;\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
BEGIN\r
getbufparam 4 33 8 34 2 34 2 13 7\r
END;\r
\r
PROCEDURE inbyteblock( VAR next : integer;\r
first, last: integer;\r
VAR msg : reference );\r
BEGIN\r
inbyteblock 4 33 2 34 2 34 2 13 7\r
END;\r
\r
PROCEDURE inword(VAR word: integer; VAR chmsg: reference);\r
BEGIN\r
inword 2 33 2 13 7\r
END;\r
\r
PROCEDURE inwordblock( VAR next : integer;\r
first, last: integer;\r
VAR msg : reference );\r
BEGIN\r
inwordblock 4 33 2 34 2 34 2 13 7\r
END;\r
\r
PROCEDURE inwordclr(VAR word: integer);\r
BEGIN\r
inwordclr 1 33 2\r
END;\r
\r
PROCEDURE iowbwc(bufparam : bufparamtype);\r
BEGIN\r
iowbwc 1 34 8\r
END;\r
\r
FUNCTION messagekind( VAR r: reference ): integer;\r
BEGIN\r
messagekind 2 35 2 13 7\r
END;\r
\r
PROCEDURE outbyteblock( VAR next : integer;\r
first, last: integer;\r
VAR msg : reference );\r
BEGIN\r
outbyteblock 4 33 2 34 2 34 2 13 7\r
END;\r
\r
PROCEDURE outword(word : integer; VAR chmsg: reference);\r
BEGIN\r
outword 2 34 2 13 7\r
END;\r
\r
PROCEDURE outwordblock( VAR next : integer;\r
first, last: integer;\r
VAR msg : reference );\r
BEGIN\r
outwordblock 4 33 2 34 2 34 2 13 7\r
END;\r
\r
PROCEDURE outwordclr(word : integer);\r
BEGIN\r
outwordclr 1 34 2\r
END;\r
\r
PROCEDURE returnx (VAR r:reference);\r
BEGIN\r
returnx 1 13 7\r
END;\r
\r
PROCEDURE sense(VAR status: integer; status_out : integer;\r
VAR chmsg: reference);\r
BEGIN\r
sense 3 33 2 34 2 13 7\r
END;\r
\r
PROCEDURE senseclr(VAR status: integer; status_out : integer;\r
compare, mask: integer);\r
BEGIN\r
senseclr 4 33 2 34 2 34 2 34 2\r
END;\r
\r
PROCEDURE setinterrupt(VAR ch : reference);\r
BEGIN\r
setinterrupt 1 13 7\r
END;\r
\r
PROCEDURE signalx(VAR r: reference; VAR m:mailbox);\r
BEGIN\r
signalx 2 13 7 9 7\r
END;\r
\r
FUNCTION timedout: boolean;\r
BEGIN\r
timedout 1 35 1\r
END;\r
\r
PROCEDURE waiti;\r
BEGIN\r
waiti 0\r
END;\r
\r
FUNCTION waitid( msecs: integer ): activation;\r
BEGIN\r
waitid 2 35 1 34 2\r
END;\r
\r
FUNCTION waitim( VAR r: reference; VAR m : mailbox ): activation;\r
BEGIN\r
waitim 3 35 1 13 7 9 7\r
END;\r
\r
FUNCTION waitimd ( VAR r: reference; VAR m : mailbox;\r
msecs : integer ): activation;\r
BEGIN\r
waitimd 4 35 1 13 7 9 7 34 2\r
END;\r
\r
\r
$IF systemenv = 1\r
---------------------------------------------------------------\r
(* Extra Routines for IMC *)\r
---------------------------------------------------------------\r
\r
PROCEDURE excptcall ( errno: integer);\r
BEGIN\r
excptcall 1 34 2\r
END;\r
\r
PROCEDURE setcreditcount ( VAR r:reference; credits: byte);\r
BEGIN\r
setcreditcou 2 13 7 34 1\r
END;\r
\r
PROCEDURE seteventkind ( VAR r:reference; event: event_type);\r
BEGIN\r
seteventkind 2 13 7 34 1\r
END;\r
\r
PROCEDURE setindex ( VAR r:reference; index: byte);\r
BEGIN\r
setindex 2 13 7 34 1\r
END;\r
\r
PROCEDURE setreason ( VAR r:reference; reason: reason_type);\r
BEGIN\r
setreason 2 13 7 34 1\r
END;\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
BEGIN\r
_initchainrc 1 6 3\r
END;\r
\r
FUNCTION addptr1 ( anyptr: ^ integer; incr: integer): ^ integer; AND\r
FUNCTION addptr2 ( anyptr: ^ process_descriptor; incr: integer): ^ process_descriptor; AND\r
FUNCTION addptr3 ( anyptr: ^ descriptor_segment; incr: integer): ^ descriptor_segment; AND\r
FUNCTION addptr4 ( anyptr: ^ byte; incr: integer): ^ byte; AND\r
FUNCTION addptr5 ( anyptr: ^ heap_head; incr: integer): ^ byte; AND\r
FUNCTION addptr6 ( anyptr: ^ byte; incr: integer): ^ mailbox; AND\r
FUNCTION addptr7 ( anyptr: ^ descriptor_segment; incr: integer): ^ program_inf; AND\r
FUNCTION addptr8 ( anyptr: ^ process_descriptor; incr: integer): ^ integer; AND\r
FUNCTION addptr9 ( anyptr: ^ descriptor_segment; incr: integer): ^ addr;\r
BEGIN\r
addptr 3 7 3 6 3 34 2\r
END;\r
\r
FUNCTION addrptr1 ( anyptr: ^ process_descriptor): addr; AND\r
FUNCTION addrptr2 ( anyptr: ^ program_descriptor): addr; AND\r
FUNCTION addrptr3 ( anyptr: ^ heap_root): addr; AND\r
FUNCTION addrptr4 ( anyptr: ^ heap_head): addr; AND\r
FUNCTION addrptr5 ( anyptr: ^ byte): addr;\r
BEGIN\r
addrptr 2 33 4 6 3\r
END;\r
\r
PROCEDURE balloc;\r
BEGIN\r
balloc 0\r
END;\r
\r
PROCEDURE bcheck;\r
BEGIN\r
bcheck 0\r
END;\r
\r
FUNCTION bcrc16buffer (frombyte, tobyte: integer; VAR r: reference): integer;\r
BEGIN\r
bcrc16buffer 4 35 2 34 2 34 2 13 7\r
END;\r
\r
FUNCTION bhometest (VAR p : pool; VAR r : reference): boolean;\r
BEGIN\r
bhometest 3 35 1 21 7 13 7\r
END;\r
\r
PROCEDURE bregion___rc;\r
BEGIN\r
bregion___rc 0\r
END;\r
\r
PROCEDURE breg_exit_rc;\r
BEGIN\r
breg_exit_rc 0\r
END;\r
\r
PROCEDURE bsetfirst;\r
BEGIN\r
bsetfirst 0\r
END;\r
\r
PROCEDURE bsetlast;\r
BEGIN\r
bsetlast 0\r
END;\r
\r
PROCEDURE bsetnext;\r
BEGIN\r
bsetnext 0\r
END;\r
\r
PROCEDURE bsetownname (INSPECT n: alfa);\r
BEGIN\r
setownname 1 134 12\r
END;\r
\r
PROCEDURE bsetu1;\r
BEGIN\r
bsetu1 0\r
END;\r
\r
PROCEDURE bsetu2;\r
BEGIN\r
bsetu2 0\r
END;\r
\r
PROCEDURE bsetu3;\r
BEGIN\r
bsetu3 0\r
END;\r
\r
PROCEDURE bsetu4;\r
BEGIN\r
bsetu4 0\r
END;\r
\r
PROCEDURE btofrom;\r
BEGIN\r
btofrom 0\r
END;\r
\r
TYPE\r
artype = ARRAY (1..maxint) OF byte;\r
arptr = ^ artype;\r
\r
FUNCTION bufstart (VAR r : reference): ^ artype;\r
BEGIN\r
bufstart 2 7 3 13 7\r
END;\r
\r
PROCEDURE bunchainref;\r
BEGIN\r
bunchainref 0\r
END;\r
\r
FUNCTION bwaitdelay(VAR r: reference; VAR m: mailbox;\r
ms: integer): activation;\r
BEGIN\r
bwaitdelay 4 35 1 13 7 9 7 34 2\r
END;\r
\r
FUNCTION carry : boolean;\r
BEGIN\r
carry 1 35 1\r
END;\r
\r
FUNCTION first (VAR r : reference): integer;\r
BEGIN\r
offset 2 35 2 13 7\r
END;\r
\r
FUNCTION getheap (VAR proc : process_descriptor) : ^ heap_root;\r
BEGIN\r
get_heap 2 7 3 25 80\r
END;\r
\r
PROCEDURE getinteger ( VAR dest: integer; srcaddr: addr);\r
BEGIN\r
getinteger 2 33 2 34 4\r
END;\r
\r
PROCEDURE getlfgf ( VAR lf, gf: addr);\r
BEGIN\r
getlfgf 2 33 4 33 4\r
END;\r
\r
FUNCTION getown : ^ process_descriptor;\r
BEGIN\r
getown 1 7 3\r
END;\r
\r
PROCEDURE getregister ( VAR dest: integer; index: integer);\r
BEGIN\r
getregister 2 33 2 34 2\r
END;\r
\r
FUNCTION last (VAR r : reference): integer;\r
BEGIN\r
last 2 35 2 13 7\r
END;\r
\r
PROCEDURE linkmessage (VAR r : reference);\r
BEGIN\r
linkmessage 1 13 7\r
END;\r
\r
PROCEDURE movebytes1 (dest: ^ process_descriptor; source: ^ byte; bytes: integer); AND\r
PROCEDURE movebytes2 (dest, source: ^ byte; bytes : integer);\r
BEGIN\r
move_bytes 3 6 3 6 3 34 2\r
END;\r
\r
FUNCTION next (VAR r : reference): integer;\r
BEGIN\r
next 2 35 2 13 7\r
END;\r
\r
PROCEDURE pexit3;\r
BEGIN\r
pexit3 0\r
END;\r
\r
FUNCTION ptr ( VAR a: integer): ^ process_descriptor;\r
BEGIN\r
ptr 2 7 3 33 2\r
END;\r
\r
FUNCTION ptraddr1 (a : addr) : ^ reference; AND\r
FUNCTION ptraddr2 (a : addr) : ^ process; AND\r
FUNCTION ptraddr3 (a : addr) : ^ mailbox; AND\r
FUNCTION ptraddr4 (a : addr) : ^ program_descriptor; AND\r
FUNCTION ptraddr5 (a : addr) : ^ message_header; AND\r
FUNCTION ptraddr6 (a : addr) : ^ process_descriptor; AND\r
FUNCTION ptraddr7 (a : addr) : ^ clocktype; AND\r
FUNCTION ptraddr8 (a : addr) : ^ byte; AND\r
FUNCTION ptraddr9 (a : addr) : ^ heap_root; AND\r
FUNCTION ptraddr10(a : addr) : ^ heap_head;\r
BEGIN\r
ptraddr 2 7 3 34 4\r
END;\r
\r
PROCEDURE readbyte ( VAR dest, src: byte);\r
BEGIN\r
readbyte 2 33 1 33 1\r
END;\r
\r
PROCEDURE readram ( VAR dest: byte; ramindex: integer);\r
BEGIN\r
readram 2 33 1 34 2\r
END;\r
\r
PROCEDURE readword ( VAR dest, src: integer);\r
BEGIN\r
readword 2 33 2 33 2\r
END;\r
\r
FUNCTION refmailbox ( VAR m: mailbox): ^ mailbox;\r
BEGIN\r
ref 2 7 3 9 7\r
END;\r
\r
FUNCTION refpool (VAR p : pool): ^ mailbox;\r
BEGIN\r
refpool 2 7 3 21 7\r
END;\r
\r
FUNCTION refprocess (VAR proc : process): ^ process;\r
BEGIN\r
refprocess 2 7 3 17 6\r
END;\r
\r
PROCEDURE selectlevel (level : integer);\r
BEGIN\r
selectlevel 1 34 2\r
END;\r
\r
PROCEDURE sensembx ( VAR r: reference; VAR m: mailbox);\r
BEGIN\r
sensembx 2 13 7 9 7\r
END;\r
\r
PROCEDURE setheap (p : ^ heap_root);\r
BEGIN\r
set_heap 1 6 3\r
END;\r
\r
PROCEDURE writeram ( ramindex, data: integer);\r
BEGIN\r
writeram 2 34 2 34 2\r
END;\r
\r
PROCEDURE writeramclr ( ramindex, data: integer);\r
BEGIN\r
writeramclr 2 34 2 34 2\r
END;\r
\r
$ENDIF\r
.\r