|
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: 14919 (0x3a47)
Types: TextFile
Names: »RTPSTD50.ENV«
└─⟦bc8c51924⟧ Bits:30010506 DVBS1.SW2114 DANOSI SW2114 Disk 1/1 Real Time Pascal Compiler Rel. 2.23 PN: 708-66-088
└─⟦this⟧ »RTPSTD50.ENV«
└─⟦dc3d6b4f1⟧ Bits:30010507 DVBS1.SW2114.rel.2.22-1 Real-Time Pascal Compiler, Rel 2.22 93.09.27
└─⟦this⟧ »RTPSTD50.ENV«
$listoff\r
stdenv; (* standard environment tog 870927 *)\r
(* transputer version tog 900706 *)\r
\r
(*----------------------------------------------------------------- \r
-- \r
-- (c) copyrigth 1993 danosi \r
-- (c) copyrigth 1992 danosi \r
-- \r
------------------------------------------------------------------- \r
-- \r
-- revisions \r
-- -------------------------------- \r
-- 1.1 87.09.27 tog standard environment\r
-- 1.2 90.07.06 tog transputer version\r
-- 1.3 92.06.04 used in release 2.14. \r
-- 1.4 92.10.22 hej sccs unix used. \r
-- 1.5 93.09.07 hej updated according to lej tog:
-- crc16, crc16buf, all imc routines removed.
-- 1.6 93.09.21 hej updated according to hhas version.
-- double int64, max, min defined.
-- \r
------------------------------------------------------------------- \r
-- sccs information \r
-- file : /usr2/sw2114/stdenv/mega/s.rtpstd50.src \r
-- module : rtpstd50.src \r
-- version: 1.6 \r
-- date : 93/09/21 12:15:34 \r
------------------------------------------------------------------- \r
*) \r
\r
(***** predefined constants *****)\r
const\r
alfalength = 12;\r
maxint = 32767; -- #h7fffffff\r
minint = -32768; -- #h80000000\r
nl = lf;\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
message_redirect, answer_redirect);\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
\r
\r
(* exception must be the first open routine *) \r
procedure exception(c: integer);\r
openroutine;\r
\r
\r
\r
\r
\r
function abs(n: integer): 0..maxint;\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): 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
openroutine;\r
\r
\r
function bufsize(var r: rtype ): 0..maxint;\r
openroutine;\r
\r
\r
function bytecount(var r: rtype ): integer;\r
openroutine;\r
\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
openroutine;\r
\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
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
-- var pr: process; size: 0..maxint; prio: integer): create_result;\r
\r
function creditcount(var r: reference): 0..maxint;\r
openroutine;\r
\r
\r
(* use wp0 as temp *)\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
external;\r
\r
function eventkind(var r: rtype): event_type;\r
openroutine;\r
\r
\r
function hometest(var r: rtype; var p: pool): boolean;\r
openroutine;\r
\r
\r
(* use wp0 as temp *)\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): byte;\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
procedure new(var p: ptype); external;\r
\r
function nil(var p:ptype ): boolean; openroutine;\r
function nil(var p:reference): boolean; openroutine;\r
function nil(var p:process): boolean;\r
openroutine;\r
\r
\r
function offset(var r:rtype ): 0..maxint; \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
external;\r
\r
function pred(v: btype): btype;\r
openroutine;\r
\r
\r
function pred(v: wtype): wtype;\r
openroutine;\r
\r
\r
procedure push(var b,s: reference);\r
external;\r
\r
function reason(var r:reference): reason_type;\r
openroutine;\r
\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
openroutine;\r
\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
openroutine;\r
\r
\r
procedure setoffset(var r: rtype ; v: integer);\r
openroutine;\r
\r
\r
procedure settop(var r: rtype ; v: integer);\r
openroutine;\r
\r
\r
\r
procedure setu1(var r: rtype ; v: byte);\r
openroutine;\r
\r
\r
procedure setu2(var r: rtype ; v: byte);\r
openroutine;\r
\r
\r
procedure setu3(var r: rtype ; v: byte);\r
openroutine;\r
\r
\r
procedure setu4(var r: rtype ; v: byte);\r
openroutine;\r
\r
\r
procedure signal(var r: reference; var m:mailbox);\r
external;\r
\r
function stackdepth(var r:reference ): 0..maxint;\r
openroutine;\r
\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
openroutine;\r
\r
\r
function succ(v:wtype): wtype;\r
openroutine;\r
\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
openroutine;\r
\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
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
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
openroutine;\r
\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
\r
\r
type int64 = record\r
lsp : integer;\r
msp : integer;\r
end;\r
const\r
int64_zero = int64(: 0, 0 :);\r
\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): int16;\r
openroutine;\r
\r
\r
(*\r
function swap(n: integer): integer;\r
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
openroutine;\r
\r
\r
procedure definetimer( on: boolean );\r
openroutine;\r
\r
\r
function equalhome(var a: rtype ; var b: rtype ): boolean;\r
openroutine;\r
\r
\r
function homeless(var r: rtype ): boolean; external;\r
\r
function imcpresent: boolean;\r
openroutine;\r
\r
\r
function locktest(var ref: reference): boolean;\r
openroutine;\r
\r
\r
function madd( a, b: integer): integer;\r
openroutine;\r
\r
\r
\r
function madd( a: int64; b: integer): int64;\r
openroutine;\r
\r
\r
function madd( a: integer; b: int64): int64;\r
openroutine;\r
\r
\r
function madd( a: int64; b: int64): int64;\r
openroutine;\r
\r
\r
\r
function max( a, b: integer): integer;\r
openroutine;\r
\r
\r
function min( 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
procedure setpriority( prio: integer);\r
openroutine;\r
\r
\r
procedure swop( var a: int16 );\r
openroutine;\r
\r
\r
procedure swop( var a: 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
(* double open routines *)\r
\r
type double = record\r
b1,b2,b3,b4 : byte;\r
end;\r
const\r
double_min = double(: 0,0,0, #h80 :);\r
double_zero = double(: 0, 0,0,0 :);\r
double_one = double(: 1,0,0,0 :);\r
double_two = double(: 2, 0,0,0 :);\r
double_max = double(: #hff,#hff,#hff, #h7f :);\r
\r
function double_add( a, b: double ): double;\r
openroutine;\r
\r
\r
procedure double_dec( var a: double );\r
openroutine;\r
\r
\r
function double_div( a, b: double ): double;\r
openroutine;\r
\r
\r
function double_mod( a, b: double ): double;\r
openroutine;\r
\r
\r
procedure double_inc( var a: double );\r
openroutine;\r
\r
\r
function double_int( a: integer ): double;\r
openroutine;\r
\r
\r
function double_uint( a: integer ): double;\r
openroutine;\r
\r
\r
function int_double( a: double): integer;\r
openroutine;\r
\r
\r
function uint_double( a: double): integer;\r
openroutine;\r
\r
\r
\r
\r
function double_lt( a, b: double ): boolean;\r
openroutine;\r
\r
\r
function double_madd( a, b: double ): double;\r
openroutine;\r
\r
\r
function double_msub( a, b: double ): double;\r
openroutine;\r
\r
\r
function double_mul( a, b: double ): double;\r
openroutine;\r
\r
\r
function double_sub( a, b: double ): double;\r
openroutine;\r
\r
\r
\r
\r
.\r