|
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: 24298 (0x5eea)
Types: TextFile
Names: »RTPSTD50.SRC«
└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
└─⟦this⟧ »RTPSTD\RTPSTD50.SRC«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »RTPSTD\RTPSTD50.SRC«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »RTPSTD\RTPSTD50.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\RTPSTD50.SRC«
$listoff\r
stdenv; (* standard environment TOG 870927 *)\r
(* transputer version TOG 900706 *)\r
\r
(***** PREDEFINED CONSTANTS *****)\r
CONST\r
maxint = 32767; -- #h7FFFFFFF\r
minint = -32768; -- #h80000000\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_no_memory=3;\r
\r
TYPE create_result = create_ok .. create_no_memory;\r
\r
CONST\r
maxpriority = 0;\r
minpriority = 0;\r
stdpriority = minpriority;\r
\r
TYPE\r
prio_type = 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
\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_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
s: INTEGER;\r
first: ^INTEGER; -- ^proc OR ^header\r
last: ^INTEGER; -- ^proc OR ^header\r
chain: ^INTEGER; -- ^mbx\r
END;\r
\r
pool_ = RECORD\r
s: INTEGER;\r
first: ^INTEGER; -- ^proc OR ^header\r
last: ^INTEGER; -- ^proc OR ^header\r
chain: ^INTEGER; -- ^pool_\r
size: INTEGER;\r
head: ^INTEGER; -- ^header\r
END;\r
\r
process_ = RECORD\r
data: ^INTEGER; -- ^proc\r
chain: ^INTEGER; -- ^process\r
END;\r
\r
\r
reference_ = RECORD\r
message: ^INTEGER; -- ^header\r
locked: INTEGER;\r
chain: ^INTEGER; -- ^ref\r
END;\r
\r
\r
chain_ = RECORD\r
message: ^INTEGER; -- ^header\r
locked: INTEGER;\r
start: ^INTEGER; -- ^header\r
length: INTEGER;\r
chain: ^INTEGER; -- ^chain\r
END;\r
\r
port_ = RECORD\r
chain: ^INTEGER; -- ^port_\r
END;\r
\r
program_descriptor = RECORD\r
state: INTEGER;\r
paramtypes: ^INTEGER; \r
poolparam: BOOLEAN;\r
lbdr: ^INTEGER; -- ^lbdr\r
entry: ^INTEGER; -- ^xxxx\r
namelength: INTEGER;\r
name: ARRAY(1..12) OF CHAR;\r
count: INTEGER;\r
chain: ^INTEGER; -- ^prog\r
END;\r
\r
(***** PREDEFINED ROUTINES *****)\r
(*********************************)\r
\r
CODE\r
\r
VAL Fault.ref.nil IS 1:\r
VAL Fault.ref.not.nil IS 2:\r
VAL Fault.ref.locked IS 3:\r
VAL Fault.range IS 4:\r
VAL Fault.set.range IS 5:\r
VAL Fault.size IS 6:\r
VAL Fault.otherwise IS 7:\r
VAL Fault.family IS 8:\r
VAL Fault.not.nil IS 9:\r
VAL Fault.nil IS 10:\r
VAL Fault.chain.empty IS 11:\r
VAL Fault.stack IS 12:\r
VAL Fault.localref IS 13:\r
VAL Fault.structure IS 14:\r
VAL Fault.addr.nil IS 15:\r
VAL Fault.deep IS 16:\r
VAL Fault.proc.not.nil IS 17:\r
VAL Fault.unlinked IS 18:\r
VAL Fault.not.implemented IS 19:\r
\r
\r
VAL nil IS 0:\r
VAL ref.nil IS -1:\r
VAL bpw IS 4:\r
\r
VAL event.none IS 0:\r
VAL event.message IS 0:\r
VAL event.answer IS 1:\r
VAL event.removed IS 2:\r
\r
VAL a.mailbox IS 0:\r
VAL a.delay IS 1:\r
VAL a.channel IS 2:\r
\r
VAL link.ok IS 0:\r
VAL already.linked IS 1:\r
VAL external.not.found IS 2:\r
\r
VAL minpriority IS 2:\r
VAL stdpriority IS 1:\r
VAL maxpriority IS 0:\r
\r
VAL unlink.ok IS 0:\r
VAL no.program.linked IS 1:\r
VAL existing.incarnations IS 2:\r
\r
VAL create.ok IS 0:\r
VAL create.no.memory IS 1:\r
\r
VAL system.size IS 7:\r
VAL system.proc. IS 0:\r
VAL system.plbdr. IS 1:\r
VAL system.rlbdr. IS 2:\r
VAL system.trace.s. IS 3:\r
VAL system.trace.first. IS 4:\r
VAL system.trace.last. IS 5:\r
VAL system.trace.chan. IS 6:\r
\r
VAL mbx.size IS 4:\r
VAL ref.size IS 3:\r
VAL pool.size IS mbx.size + 2:\r
\r
\r
VAL proc.chan. IS 0:\r
VAL proc.next. IS 1:\r
VAL proc.system. IS 2:\r
VAL proc.freemem. IS 3:\r
VAL proc.newsmall. IS 4:\r
VAL proc.newhead. IS 5:\r
VAL proc.stackfirst. IS 6:\r
VAL proc.stacktop. IS 7:\r
VAL proc.stacklimit. IS 8:\r
VAL proc.stackheap. IS 9:\r
VAL proc.fault. IS 10:\r
VAL proc.stop. IS 11:\r
VAL proc.exit. IS 12:\r
VAL proc.remove. IS 13:\r
VAL proc.wp. IS 14:\r
VAL proc.ip. IS 15:\r
VAL proc.wp.0. IS 16:\r
VAL proc.wp.1. IS 17:\r
VAL proc.state. IS 18:\r
VAL proc.parent. IS 19:\r
VAL proc.prog. IS 20:\r
VAL proc.error. IS 21:\r
VAL proc.chain. IS 22:\r
VAL proc.mbxhead. IS 23:\r
VAL proc.refhead. IS 24:\r
VAL proc.localrefhead. IS 25:\r
VAL proc.chainhead. IS 26:\r
VAL proc.semhead. IS 27:\r
VAL proc.poolhead. IS 28:\r
VAL proc.porthead. IS 29:\r
VAL proc.prochead. IS 30:\r
VAL proc.processhead. IS 31:\r
VAL proc.proghead. IS 32:\r
VAL proc.sharedhead. IS 33:\r
VAL proc.namelength. IS 34:\r
VAL proc.name. IS 35:\r
\r
VAL proc.namedmbx. IS 38:\r
VAL proc.operator. IS 39:\r
VAL proc.timer. IS 40:\r
VAL proc.ref. IS 41:\r
VAL proc.mbx. IS 44: \r
VAL proc.pool. IS 48: \r
\r
VAL proc.state.active IS 0:\r
VAL proc.state.stopped IS 1:\r
VAL proc.state.fault IS 2:\r
VAL proc.state.exit IS 3:\r
VAL proc.state.removed IS 4:\r
\r
VAL proc.size IS 54: \r
\r
VAL lbdr.size IS 14:\r
VAL lbdr.entry. IS 0:\r
VAL lbdr.linetable. IS 1:\r
VAL lbdr.globalsize. IS 2:\r
VAL lbdr.appetite. IS 3:\r
VAL lbdr.stackextra. IS 4:\r
VAL lbdr.vectorspace. IS 5:\r
VAL lbdr.codesize. IS 6:\r
VAL lbdr.linkcount. IS 7:\r
VAL lbdr.chain. IS 8:\r
VAL lbdr.namelength. IS 9:\r
VAL lbdr.name. IS 10:\r
VAL lbdr.kind. IS 13:\r
\r
\r
\r
VAL process.size IS 2:\r
VAL process.data. IS 0:\r
VAL process.chain. IS 1:\r
\r
\r
VAL prog.size IS 11:\r
VAL prog.state. IS 0:\r
VAL prog.paramtypes. IS 1:\r
VAL prog.poolparam. IS 2:\r
VAL prog.lbdr. IS 3:\r
VAL prog.entry. IS 4:\r
VAL prog.namelength. IS 5:\r
VAL prog.name. IS 6:\r
VAL prog.count. IS 9:\r
VAL prog.chain. IS 10:\r
\r
VAL prog.internal IS 0:\r
VAL prog.unlinked IS 1:\r
VAL prog.linked IS 2:\r
\r
\r
VAL mbx.s. IS 0:\r
VAL mbx.first. IS 1:\r
VAL mbx.last. IS 2:\r
VAL mbx.chain. IS 3:\r
VAL mbx.process. IS 0:\r
\r
\r
VAL ref.message. IS 0:\r
VAL ref.locked. IS 1:\r
VAL ref.chain. IS 2:\r
\r
VAL chain.size IS 6: \r
VAL chain.message. IS 0: \r
VAL chain.locked. IS 1: \r
VAL chain.chain. IS 2: \r
VAL chain.start. IS 3: \r
VAL chain.length. IS 4: \r
\r
\r
VAL pool.s. IS 0: \r
VAL pool.first. IS 1: \r
VAL pool.last. IS 2: \r
VAL pool.chain. IS 3: \r
VAL pool.size. IS 4: \r
VAL pool.head. IS 5: \r
\r
VAL pool.process. IS 0: \r
\r
VAL shared.size IS 3:\r
VAL shared.object. IS 0:\r
VAL shared.count. IS 1:\r
VAL shared.chain. IS 2:\r
\r
\r
VAL header.size IS 16:\r
VAL header.bytes IS 64:\r
VAL header.buffer. IS 0:\r
VAL header.next. IS 1:\r
VAL header.size. IS 2:\r
VAL header.offset. IS 3:\r
VAL header.top. IS 4:\r
VAL header.bytecount. IS 5:\r
VAL header.return. IS 6:\r
VAL header.home. IS 7:\r
VAL header.imc. IS 8:\r
VAL header.eventkind. IS 32: \r
VAL header.index. IS 33: \r
VAL header.creditcount. IS 34: \r
VAL header.reason. IS 35: \r
VAL header.user. IS 9:\r
VAL header.u1. IS 36: \r
VAL header.u2. IS 37: \r
VAL header.u3. IS 38: \r
VAL header.u4. IS 39: \r
VAL header.stack. IS 10:\r
VAL header.depth. IS 11:\r
VAL header.bufcount. IS 12:\r
VAL header.succ. IS 13:\r
VAL header.pred. IS 14:\r
VAL header.chain. IS 15:\r
\r
VAL port.size IS 1:\r
\r
VAL port.chain. IS 0:\r
\r
VAL mbxname.size IS 5:\r
VAL mbxname.bytes IS 20: \r
\r
VAL mbxname.next. IS 0:\r
VAL mbxname.mbx. IS 1:\r
VAL mbxname.name. IS 2:\r
\r
END;\r
\r
(* exception must be the first open routine *) \r
PROCEDURE exception(c: integer);\r
BEGIN 0\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
END;\r
\r
\r
\r
\r
FUNCTION abs(n: integer): 0..maxint;\r
BEGIN 0\r
XDBLE\r
XDBLE\r
XOR\r
REV\r
DIFF\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): 0..maxint;\r
EXTERNAL;\r
\r
FUNCTION allocpool(VAR p: pool; no_of_bufs, bufsize: integer): 0..maxint;\r
EXTERNAL;\r
\r
PROCEDURE break(VAR proc: process; fault: integer);\r
EXTERNAL;\r
\r
FUNCTION bufcount(VAR r: reference): 0..maxint;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
LDNL header.bufcount.\r
LABEL 0\r
END;\r
\r
FUNCTION bufsize(VAR r: rtype ): 0..maxint;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
LDNL header.size.\r
END;\r
\r
FUNCTION bytecount(VAR r: rtype ): integer;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
LDNL header.bytecount.\r
END;\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): 0..maxint;\r
BEGIN 0\r
LDNL chain.length.\r
END;\r
\r
PROCEDURE chainreset(VAR ch: chain);\r
EXTERNAL;\r
\r
PROCEDURE chainstart(VAR ch: chain);\r
EXTERNAL;\r
\r
PROCEDURE chainup(VAR ch: chain);\r
EXTERNAL;\r
\r
FUNCTION ord(v: btype): integer; \r
BEGIN 0\r
LDC 255\r
AND\r
END; \r
\r
FUNCTION ord(v: wtype): integer; AND\r
FUNCTION chr(v: byte): char; \r
BEGIN 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
-- VAR pr: process; size: 0..maxint; prio: integer): create_result;\r
\r
FUNCTION creditcount(VAR r: reference): 0..maxint;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.creditcount.\r
LB\r
END;\r
\r
(* use WP0 as temp *)\r
\r
PROCEDURE dec(VAR v: byte);\r
BEGIN 0\r
STL 0 \r
LDL 0\r
LB\r
ADC -1\r
LDL 0\r
SB\r
END;\r
\r
PROCEDURE dec(VAR v: integer);\r
BEGIN 0\r
STL 0 \r
LDL 0\r
LDNL 0\r
LDC 1\r
DIFF\r
LDL 0\r
STNL 0\r
END;\r
\r
PROCEDURE delay(ms: integer);\r
EXTERNAL;\r
\r
FUNCTION eventkind(VAR r: rtype): event_type;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.eventkind.\r
LB\r
END;\r
\r
FUNCTION hometest(VAR r: rtype; VAR p: pool): boolean;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
LDNL header.home.\r
DIFF\r
EQC 0\r
END;\r
\r
(* use WP0 as temp *)\r
\r
PROCEDURE inc(VAR v: byte);\r
BEGIN 0\r
STL 0 \r
LDL 0\r
LB\r
ADC 1\r
LDL 0\r
SB\r
END;\r
\r
PROCEDURE inc(VAR v:integer);\r
BEGIN 0\r
STL 0 \r
LDL 0\r
LDNL 0\r
LDC 1\r
SUM\r
LDL 0\r
STNL 0\r
END;\r
\r
FUNCTION index(VAR r:reference): byte;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.index.\r
LB\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 0\r
LDNL mbx.s.\r
LDC 0\r
REV\r
GT\r
END;\r
\r
PROCEDURE new(VAR p: ptype); EXTERNAL;\r
\r
FUNCTION nil(VAR p:ptype ): boolean; and\r
FUNCTION nil(VAR p:reference): boolean; and\r
FUNCTION nil(VAR p:process): boolean;\r
BEGIN 0\r
LDNL 0\r
EQC 0 \r
END;\r
\r
FUNCTION offset(VAR r:rtype ): 0..maxint; \r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
LDNL header.offset.\r
END;\r
\r
FUNCTION open(VAR m:mailbox): boolean; AND\r
FUNCTION openpool(VAR p: pool): boolean;\r
BEGIN 0\r
LDNL mbx.s.\r
LDC 0\r
GT\r
END;\r
\r
FUNCTION passive(VAR m:mailbox): boolean;\r
BEGIN 0\r
LDNL mbx.s.\r
EQC 0\r
END;\r
\r
PROCEDURE pop(VAR b,s: reference);\r
EXTERNAL;\r
\r
FUNCTION pred(v: btype): btype;\r
BEGIN 0\r
STL -3\r
LDLP -3\r
LB\r
SUB\r
EQC 0\r
CJ .nofault\r
SETERR\r
:nofault\r
LDLP -3\r
LB\r
ADC -1\r
END;\r
\r
FUNCTION pred(v: wtype): wtype;\r
BEGIN 0\r
STL -3\r
LDL -3\r
SUB\r
EQC 0\r
CJ .nofault\r
SETERR\r
:nofault\r
LDL -3\r
ADC -1\r
END;\r
\r
PROCEDURE push(VAR b,s: reference);\r
EXTERNAL;\r
\r
FUNCTION reason(VAR r:reference): reason_type;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.reason.\r
LB\r
END;\r
\r
PROCEDURE release(VAR r: reference);\r
EXTERNAL;\r
\r
FUNCTION releasepool(VAR p:pool; bufs: integer): 0..maxint;\r
EXTERNAL;\r
\r
PROCEDURE remove(VAR pr: process);\r
EXTERNAL;\r
\r
PROCEDURE resetevent(VAR r: rtype);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
ADC header.eventkind.\r
LDC 0\r
REV\r
SB\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE resume(VAR pr: process);\r
EXTERNAL;\r
\r
PROCEDURE return(VAR r:reference);\r
EXTERNAL;\r
\r
PROCEDURE setbytecount(VAR r: rtype ; v: integer);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
STNL header.bytecount.\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE setoffset(VAR r: rtype ; v: integer);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
STNL header.offset.\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE settop(VAR r: rtype ; v: integer);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
STNL header.top.\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
\r
PROCEDURE setu1(VAR r: rtype ; v: byte);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
ADC header.u1.\r
SB\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE setu2(VAR r: rtype ; v: byte);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
ADC header.u2.\r
SB\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE setu3(VAR r: rtype ; v: byte);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
ADC header.u3.\r
SB\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE setu4(VAR r: rtype ; v: byte);\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
ADC header.u4.\r
SB\r
JUMP 1\r
LABEL 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 1\r
END;\r
\r
PROCEDURE signal(VAR r: reference; VAR m:mailbox);\r
EXTERNAL;\r
\r
FUNCTION stackdepth(VAR r:reference ): 0..maxint;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 0\r
LDNL header.depth.\r
LABEL 0\r
END;\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;\r
BEGIN 0\r
STL -3\r
LDLP -3\r
LB\r
SUB\r
EQC 0\r
CJ .nofault\r
SETERR\r
:nofault\r
LDLP -3\r
LB\r
ADC 1\r
END;\r
\r
FUNCTION succ(v:wtype): wtype;\r
BEGIN 0\r
STL -3\r
LDL -3\r
SUB\r
EQC 0\r
CJ .nofault\r
SETERR\r
:nofault\r
LDL -3\r
ADC 1\r
END;\r
\r
PROCEDURE tofrom(VAR toref: reference; toindex: integer;\r
VAR fromref: reference; fromindex: integer;\r
bytes: integer );\r
EXTERNAL;\r
\r
FUNCTION top(VAR r:rtype ): 0..maxint;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
LDNL header.top.\r
END;\r
\r
PROCEDURE trace(f: integer);\r
EXTERNAL;\r
\r
PROCEDURE stacktrace(f: integer);\r
EXTERNAL;\r
\r
FUNCTION unlink(VAR prog: program_descriptor): unlink_result; EXTERNAL;\r
\r
FUNCTION u1(VAR r:rtype ): byte;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.u1.\r
LB\r
END;\r
\r
FUNCTION u2(VAR r:rtype ): byte;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.u2.\r
LB\r
END;\r
\r
FUNCTION u3(VAR r:rtype ): byte;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.u3.\r
LB\r
END;\r
\r
FUNCTION u4(VAR r:rtype ): byte;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
ADC header.u4.\r
LB\r
END;\r
\r
PROCEDURE wait( VAR r: reference; VAR m: mailbox);\r
EXTERNAL;\r
\r
FUNCTION waitdelay(VAR r: reference; VAR m: mailbox;\r
ms: integer): activation;\r
EXTERNAL;\r
\r
FUNCTION alias(VAR p:port; INSPECT name: string ): boolean;\r
BEGIN 0\r
LDC 0\r
END;\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:0..maxint;\r
EXTERNAL;\r
\r
PROCEDURE openport(VAR p:port; VAR closebuf: reference;\r
inspect name:string; scope: scope_type;\r
no_of_cons: integer; 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=record\r
year_after_1900: byte;\r
month: byte;\r
day: byte;\r
end;\r
\r
coded_time=record\r
hour: byte;\r
minute: byte;\r
end;\r
\r
coded_secs=packed record\r
sec: byte;\r
msec: int16;\r
end;\r
\r
coded_inc= record\r
days: 0..31;\r
hours: 0..23;\r
mins: 0..59;\r
secs: 0..59;\r
msecs: int16;\r
end;\r
\r
delaytype= 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= record\r
date: coded_date;\r
time: coded_time;\r
secs: coded_secs;\r
end;\r
\r
tversion= record\r
release, subrelease: byte;\r
end;\r
\r
tmoduleversion= record\r
moduledate: coded_date;\r
moduletime: coded_time;\r
moduleversion: tversion;\r
compilationdate: coded_date;\r
compilationtime: coded_time;\r
end;\r
\r
function clock_difference( var t1, t2: clocktype ): coded_inc;\r
external;\r
\r
function clock_increment( var t: clocktype; var inc: coded_inc ): clocktype;\r
external;\r
\r
function clock_less_than( var t1, t2: clocktype ): boolean;\r
external;\r
\r
FUNCTION deletemailbox(INSPECT mbx_name: string): integer;\r
EXTERNAL;\r
\r
FUNCTION getclock: clocktype;\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
\r
PROCEDURE sendtimer(VAR ref: reference );\r
EXTERNAL;\r
\r
PROCEDURE setownname(INSPECT name: string );\r
EXTERNAL;\r
\r
FUNCTION swap(n: int16): integer;\r
BEGIN 0\r
STL -3\r
LDL -3\r
LDC 255\r
AND\r
LDC 8\r
SHL\r
LDL -3\r
LDC 8\r
SHR\r
LDC 255\r
AND\r
OR\r
END;\r
\r
(*\r
FUNCTION swap(n: integer): integer;\r
BEGIN 0\r
STL -3\r
LDL -3\r
LDC 24\r
SHL\r
LDLP -3\r
ADC 1\r
LB\r
LDC 16\r
SHL \r
OR\r
LDLP -3\r
ADC 2\r
LB\r
LDC 8\r
SHL\r
OR\r
LDLP -3\r
ADC 3\r
LB\r
OR\r
END;\r
*)\r
(* Implementation demendent open routines *) \r
\r
PROCEDURE breakpoint;\r
BEGIN 0\r
J 0\r
END;\r
\r
PROCEDURE crc16( value, quotient: integer );\r
EXTERNAL;\r
\r
PROCEDURE crc16buf( VAR ref: reference; fromindex, toindex, quotient, startvalue: integer);\r
EXTERNAL; \r
\r
PROCEDURE definetimer( on: boolean );\r
BEGIN 0\r
END;\r
\r
FUNCTION equalhome(VAR a: rtype ; VAR b: rtype ): boolean;\r
BEGIN 1\r
LDNL ref.message.\r
XDBLE\r
REV\r
NOT\r
CJUMP 0\r
LABEL 1\r
LDC fault.ref.nil\r
PUSHPROC\r
PUSHPROC\r
LDNL proc.fault.\r
GCALL\r
LABEL 0\r
OR\r
LDNL header.home.\r
REV\r
LDNL ref.message.\r
XDBLE\r
REV\r
CJUMP 1\r
LDNL header.home.\r
DIFF\r
EQC 0\r
END;\r
\r
FUNCTION homeless(VAR r: rtype ): boolean; EXTERNAL;\r
\r
FUNCTION imcpresent: boolean;\r
BEGIN 1\r
LDC 0\r
END; \r
\r
FUNCTION locktest(VAR ref: reference): boolean;\r
BEGIN 1\r
LDNL ref.locked.\r
EQC 0\r
EQC 0\r
END; \r
\r
PROCEDURE getservers( VAR ref: reference );\r
EXTERNAL;\r
\r
FUNCTION madd( a, b: integer): integer;\r
BEGIN 0\r
SUM\r
END;\r
\r
FUNCTION mmul( a, b: integer): integer;\r
BEGIN 0\r
PROD\r
END;\r
\r
FUNCTION msub( a, b: integer): integer;\r
BEGIN 0\r
REV\r
DIFF\r
END;\r
\r
FUNCTION rotate( a, shl: integer): integer;\r
BEGIN 0\r
STL -3\r
LDC 31\r
AND\r
LDC 0\r
REV\r
LDL -3\r
REV\r
LSHL\r
OR\r
END;\r
\r
PROCEDURE setpriority( prio: integer);\r
BEGIN 0\r
END;\r
\r
FUNCTION uadd( a, b: integer): integer;\r
BEGIN 0\r
STL -3\r
LDC 0\r
REV\r
LDL -3\r
LSUM\r
REV\r
LDC 1\r
CSUB0\r
OR\r
END;\r
\r
FUNCTION udiv( a, b: integer): integer;\r
BEGIN 0\r
STL -3\r
LDC 0\r
REV\r
LDL -3\r
REV\r
LDIV\r
END;\r
\r
FUNCTION ult( a, b: integer): boolean;\r
BEGIN 0\r
STL -3\r
LDC 0\r
REV\r
LDL -3\r
LDIFF\r
REV\r
GT\r
END;\r
\r
FUNCTION umod( a, b: integer): integer;\r
BEGIN 0\r
STL -3\r
LDC 0\r
REV\r
LDL -3\r
REV\r
LDIV\r
REV\r
END;\r
\r
FUNCTION umul( a, b: integer): integer;\r
BEGIN 0\r
STL -3\r
LDC 0\r
REV\r
LDL -3\r
LMUL\r
REV\r
LDC 1\r
CSUB0\r
OR\r
END;\r
\r
FUNCTION usub( a, b: integer): integer;\r
BEGIN 0\r
STL -3\r
LDC 0\r
REV\r
LDL -3\r
REV\r
LDIFF\r
REV\r
LDC 1\r
CSUB0\r
OR\r
END;\r
\r
\r
.\r