|
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: 21496 (0x53f8)
Types: TextFile
Names: »RTPSTD35.SRC«
└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
└─⟦this⟧ »RTPSTD\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, procedure ownversion.\r
-- 92.06.12 HEJ Extra open routines removed.\r
-- 92.06.19 HEJ The type of index changed: byte -> integer,\r
-- - parameter of locktest changed: mailbox -> reference\r
--\r
-----------------------------------------------\r
*)\r
\r
(***** predefined constants *****)\r
const\r
(*alfalength = 12;*)\r
maxint = 32767;\r
minint = -32768;\r
\r
\r
(***** predefined types *****)\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 = packed record\r
rcv_all,\r
get_credit: boolean;\r
end;\r
\r
\r
(* shielded type declarations *)\r
(******************************)\r
\r
mailbox_ = record\r
nulbyte: byte;\r
mbx : ^integer; -- ^proc or ^header\r
chain : ^integer; -- ^mbx\r
end;\r
\r
pool_ = record\r
nulbyte: byte;\r
mbx : ^integer; -- ^proc or ^header\r
chain : ^integer; -- ^pool_\r
end;\r
\r
process_ = record\r
data : ^integer; -- ^proc\r
chain: ^integer; -- ^process\r
end;\r
\r
\r
reference_ = record\r
locked : byte;\r
message: ^integer; -- ^header\r
chain : ^integer; -- ^ref\r
end;\r
\r
\r
chain_ = record\r
message: ^integer; -- ^header\r
start : ^integer; -- ^header\r
length : integer;\r
end;\r
\r
port_ = 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
program_descriptor = record\r
count : integer;\r
paramtypes: ^integer;\r
state : integer;\r
lbdr : ^integer; -- ^lbdr\r
name : array(1..12) of char;\r
chain : ^integer; -- ^prog\r
end;\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
coded_date=PACKED RECORD\r
year_after_1900: 0..127;\r
month: 0..12;\r
day: 0..31;\r
END;\r
\r
coded_time=PACKED RECORD\r
compiler_version : 0..31;\r
hour: 0..23;\r
minute: 0..59;\r
END;\r
\r
coded_secs=PACKED RECORD\r
sec: 0..59;\r
msec: 0..999;\r
END;\r
\r
coded_inc= 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= 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= PACKED RECORD\r
date: coded_date;\r
time: coded_time;\r
secs: coded_secs;\r
END;\r
\r
tversion= RECORD\r
release, subrelease: byte; -- version, issue\r
END;\r
\r
compilerid_type = 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= 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
(* *)\r
lookup_descriptor_segment = 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
inmordblock 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 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
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
<*--- removed :\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 signalx(VAR r: reference; VAR m:mailbox);\r
BEGIN\r
signalx 2 13 7 9 7\r
END;\r
\r
PROCEDURE returnx (VAR r:reference);\r
BEGIN\r
returnx 1 13 7\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
(* other useful routines *)\r
----------------------------------------\r
\r
Type\r
xmem_no_type = 0..127;\r
\r
base_type = packed record\r
mem_no : xmem_no_type;\r
nilbit : bit\r
end;\r
\r
addr = record\r
nulbyte : byte;\r
base : base_type;\r
disp : integer\r
end;\r
\r
adr = record\r
base : base_type;\r
disp : integer\r
end;\r
\r
\r
descriptor_segment = 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
\r
FUNCTION addptr ( anyptr: ^integer; incr: integer): ^integer;\r
BEGIN\r
addptr 3 7 3 6 3 34 2\r
END;\r
\r
FUNCTION addrptr ( anyptr: ^integer): addr;\r
BEGIN\r
addrptr 2 33 4 6 3\r
END;\r
\r
FUNCTION baseinteger ( b: integer) : addr;\r
BEGIN\r
baseinteger 2 33 4 34 2\r
END;\r
\r
FUNCTION carry : boolean;\r
BEGIN\r
carry 1 35 1\r
END;\r
\r
PROCEDURE getaddr ( var dest: addr; src: addr);\r
BEGIN\r
getaddr 2 33 4 34 4\r
END;\r
\r
PROCEDURE getbyte ( var dest: byte; srcaddr: addr);\r
BEGIN\r
getbyte 2 33 1 34 4\r
END;\r
\r
FUNCTION getid : integer;\r
BEGIN\r
getid 1 35 2\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
PROCEDURE getregister ( var dest: integer; index: integer);\r
BEGIN\r
getregister 2 33 2 34 2\r
END;\r
\r
FUNCTION ptr ( a: byte): ^byte;\r
BEGIN\r
ptr 2 7 3 34 1\r
END;\r
\r
FUNCTION ptr ( a: integer): ^integer;\r
BEGIN\r
ptr 2 7 3 34 2\r
END;\r
\r
FUNCTION ptr ( p: ^integer): ^integer;\r
BEGIN\r
ptr 2 7 3 34 3\r
END;\r
\r
FUNCTION ptr ( a: addr): ^integer;\r
BEGIN\r
ptr 2 7 3 34 4\r
END;\r
\r
FUNCTION ptraddr ( a: addr): ^integer;\r
BEGIN\r
ptraddr 2 7 3 34 4\r
END;\r
\r
PROCEDURE putaddr ( a, b: addr);\r
BEGIN\r
putaddr 2 34 4 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 ref_mailbox ( var m: mailbox): ^ mailbox;\r
BEGIN\r
ref 2 7 3 9 7\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 writeram ( ramindex, data: integer);\r
BEGIN\r
writeram 2 34 2 34 2\r
END;\r
\r
---------*>\r
.\r
«eof»