|
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: 20021 (0x4e35)
Types: TextFile
Names: »RTPNEW35.ENV«, »RTPSTD35.ENV«
└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
└─⟦this⟧ »RTPSTD\RTPNEW35.ENV«
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTPSTD35.ENV«
└─⟦f37defc27⟧ Bits:30010517 DVBS1.SW2114.rel.2.7 SW2114 Real Time Pascal Release 2.7 Compiler Danosi 92.06.06
└─⟦this⟧ »RTPSTD35.ENV«
$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
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
\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
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
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 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
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
<*--- removed :\r
\r
(* extra routines for imc *)\r
---------------------------------------------------------------\r
\r
procedure excptcall ( errno: integer);\r
\r
excptcall 1 34 2\r
end;\r
\r
procedure signalx(var r: reference; var m:mailbox);\r
\r
signalx 2 13 7 9 7\r
end;\r
\r
procedure returnx (var r:reference);\r
\r
returnx 1 13 7\r
end;\r
\r
procedure setcreditcount ( var r:reference; credits: byte);\r
\r
setcreditcou 2 13 7 34 1\r
end;\r
\r
procedure seteventkind ( var r:reference; event: event_type);\r
\r
seteventkind 2 13 7 34 1\r
end;\r
\r
procedure setindex ( var r:reference; index: byte);\r
\r
setindex 2 13 7 34 1\r
end;\r
\r
procedure setreason ( var r:reference; reason: reason_type);\r
\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
\r
addptr 3 7 3 6 3 34 2\r
end;\r
\r
function addrptr ( anyptr: ^integer): addr;\r
\r
addrptr 2 33 4 6 3\r
end;\r
\r
function baseinteger ( b: integer) : addr;\r
\r
baseinteger 2 33 4 34 2\r
end;\r
\r
function carry : boolean;\r
\r
carry 1 35 1\r
end;\r
\r
procedure getaddr ( var dest: addr; src: addr);\r
\r
getaddr 2 33 4 34 4\r
end;\r
\r
procedure getbyte ( var dest: byte; srcaddr: addr);\r
\r
getbyte 2 33 1 34 4\r
end;\r
\r
function getid : integer;\r
\r
getid 1 35 2\r
end;\r
\r
procedure getinteger ( var dest: integer; srcaddr: addr);\r
\r
getinteger 2 33 2 34 4\r
end;\r
\r
procedure getlfgf ( var lf, gf: addr);\r
\r
getlfgf 2 33 4 33 4\r
end;\r
\r
procedure getregister ( var dest: integer; index: integer);\r
\r
getregister 2 33 2 34 2\r
end;\r
\r
function ptr ( a: byte): ^byte;\r
\r
ptr 2 7 3 34 1\r
end;\r
\r
function ptr ( a: integer): ^integer;\r
\r
ptr 2 7 3 34 2\r
end;\r
\r
function ptr ( p: ^integer): ^integer;\r
\r
ptr 2 7 3 34 3\r
end;\r
\r
function ptr ( a: addr): ^integer;\r
\r
ptr 2 7 3 34 4\r
end;\r
\r
function ptraddr ( a: addr): ^integer;\r
\r
ptraddr 2 7 3 34 4\r
end;\r
\r
procedure putaddr ( a, b: addr);\r
\r
putaddr 2 34 4 34 4\r
end;\r
\r
procedure readbyte ( var dest, src: byte);\r
\r
readbyte 2 33 1 33 1\r
end;\r
\r
procedure readram ( var dest: byte; ramindex: integer);\r
\r
readram 2 33 1 34 2\r
end;\r
\r
procedure readword ( var dest, src: integer);\r
\r
readword 2 33 2 33 2\r
end;\r
\r
function ref_mailbox ( var m: mailbox): ^ mailbox;\r
\r
ref 2 7 3 9 7\r
end;\r
\r
procedure sensembx ( var r: reference; var m: mailbox);\r
\r
sensembx 2 13 7 9 7\r
end;\r
\r
procedure writeram ( ramindex, data: integer);\r
\r
writeram 2 34 2 34 2\r
end;\r
\r
---------*>\r
.\r