DataMuseum.dk

top - metrics - download

    Length: 8448 (0x2100)
    Types: TextFileVerbose
    Names: »platonenv«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »platonenv« 

TextFileVerbose

standard_environment;
(* version : 51           *)
(* revision 3             *)
(* date : 81.01.19  , bbl *)


const

alfalength = 12;
maxint = 32767;
minint = -32768;
mpexcfirst = 1;
rsexcfirst = mpexcfirst + 30;
cpexcfirst = rsexcfirst + 5;


maxpriority = 3;
minpriority = -3;
stdpriority = minpriority;



type

(* basic types *)
bit = 0..1;
byte = 0..255;
puno_type = 0..63;
memno_type = 0..31;

activation = (a_interrupt, a_semaphore, a_delay);


base_type = packed record
busy : bit;
nill : bit;
unused : 0..7;
pu_no : puno_type;
mem_no : memno_type
end;
 
addr = record
base : base_type;
disp : integer
end;


boolean = (false,true);
 
char =(
(*           0    1    2    3    4    5    6    7    8    9  *)
 
(*   0 *)   nul, soh, stx, etx, eot, enq, ack, bel,  bs,  ht,
(*  10 *)    nl,  vt,  ff,  cr,  so,  si, dle, dc1, dc2, dc3,
(*  20 *)   dc4, nak, syn, etb, can,  em, sub, esc,  fs,  gs,
(*  30 *)    rs,  us,  sp,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(*  40 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(*  50 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(*  60 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(*  70 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(*  80 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(*  90 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(* 100 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(* 110 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,   ?,
(* 120 *)     ?,   ?,   ?,   ?,   ?,   ?,   ?, del );
 
 
alfa = array ( 1..alfalength ) of char;

semaphore = record
? <* chain *> : addr; (* message_headers or incarnation_descriptors *)
? <* semchain *> : ^ semaphore   (* used by exit *)
end;


sempointer = ^ semaphore;


message_header = record
? <* chain *> : ^ message_header;
messagekind : ! integer;
size : ! integer;
? <* start *> : addr; (* start of message data part *)
? <* owner *> : sempointer;
? <* answer *> : sempointer;
? <* msg_chain *> : ^ message_header;
? <* stackchain *> : ^ message_header;
u1, u2, u3, u4 : byte
end;

reference = ^ message_header;
(* nb nb nb nb : all variables of type reference are allocated *)
(*                memory space as two pointer variables        *)

shadow = record
? <* r *> : reference;
? <* next *> : ^ shadow  (* used by exit *)
end;


process_inf = record
entry_point : addr;
exception_point : addr;
exit_point : addr;
exception_mask : integer;
last_param_offset : integer
end;


process_descriptor = record (* the "type" of a process name *)
incarnationcount : integer;
param_descr_ref : addr; (* address of formal parameters *)
link_state : integer; (* 0: unlinked  1: internal linked  2: external linked *)
process_inf_ref : addr; (* pointer to descriptorsegment if external linked
                           pointer to process_inf       if internal linked *)
name : alfa
end;

processrec = record  (* used by create *)
processref : ^ process_descriptor;
firstparam : addr;
size_of_params : integer
end;

semtype1 = (deallocatorsem,linkersem,stopsem,allocsem,exceptionsem,opsem,?,?,
             ?,?,?,?,
            monitorsem,?,timersem,iotimersem,?,?,?,monitorstack,
             timerstack,allocatorstack,linkerstack,adamstack);

adamsemtype = (allocatorsem,adamsem,operatorsem,?,?,?,?,?,
            ?,?,?,?,?,?,?,?);

secret_vector = array(semtype1) of sempointer;

adamvector = array(adamsemtype) of  sempointer;

system_vector = ! adamvector;

secret_pointer_t = ^ secret_vector;

public_pointer_t = ^ system_vector;

incarnation_descriptor = record
(* the incarnation descriptor appearing as the first part of global frame *)
? <* chain *> : addr;
? <* pu *> : byte;
? <* level *> : byte;
? <* incstate *> : integer;
? <* msg_waited *> : addr;
? <* activequeue *> : addr;
? <* chainhead *> : addr;
? <* exception_mask *> : integer;
? <* exception_point *> : addr;
? <* exic *> : addr;
? <* dumplm *> : integer;
? <* dumpps *> : integer;
? <* dumplu *> : integer;
? <* dumpsf *> : integer;
? <* entry_point *> : addr;
timer : integer;
? <* maxstack *> : integer;
? <* processref *> : ^ process_descriptor;
? <* semchain *> : sempointer;
? <* refchain *> : ^ reference;
? <* shadowchain *> : ^ shadow;
? <* msg_chain *> : ^ message_header;
? <* exit_point *> : addr;
? <* exit_semaphore *> : semaphore;
? <* exitref *> : reference;
? <* secret_pointer *> : secret_pointer_t;
? <* plinetable *> : addr;
incname : alfa;
end;

var
(* now a variable of type incarnation_descriptor must!! be declared
as the first variable *)

own : incarnation_descriptor;


(* now the standard routines are defined as externals *)

function abs(x : niltype) : niltype; external;

procedure alloc(var r : reference; var p : pool 100 ;
var sem : semaphore); external;

procedure break(var sh : shadow; excode : integer); external;

function chr(int : 0..127) : char; external;

function create(incarnation_name : alfa; proces : processrec; var sh : shadow;
storage : integer) : integer; external;

procedure definetimer(onoff:boolean); external;

function empty(var r : reference) : boolean; external;

function eoi : boolean; external;

procedure exception(excode : integer);
external;

procedure inbyteblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
external;

procedure inwordblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
external;


function link(external_name : alfa;
var proces : process_descriptor) : integer; external;

function locked(var sem : semaphore) : boolean; external;

function nil(var r : ^ niltype) : boolean; external;

function open(var sem : semaphore) : boolean; external;

function openpool(var p : pool 1) : boolean;
external;


function ord(x : niltype) : integer; external;

procedure outbyteblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
external;

procedure outwordblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
external;

function ownertest(var p : pool 1; var r : reference) : boolean;
external;


function passive(var sem : semaphore) : boolean; external;

procedure pop(var r1, r2 : reference); external;

function pred(x : niltype) : niltype; external;

procedure push(var r1, r2 : reference); external;

function ref(var sem : semaphore) : sempointer; external;

procedure release(var r : reference); external;

procedure remove(var sh : shadow); external;

function reservech(var ch_msg : reference; level, mask : integer): integer; external;

procedure return(var r : reference); external;

procedure sendtimer(var r : reference);
external;

procedure sensesem(var r : reference; var sem : semaphore);
external;

procedure signal(var r : reference; var sem : semaphore); external;

procedure start(var sh : shadow; priority : integer); external;

procedure stop(var sh : shadow); external;

function succ(x : niltype) : niltype; external;
procedure trace = exception( code : integer ) ; external;

function unlink(var proces : process_descriptor) : integer; external;

procedure wait(var r : reference; var sem : semaphore); external;

procedure waiti; external;

procedure waits = wait(var r : reference; var sem : semaphore); external;

procedure waitd(delay : integer); external;

function waitid(delay : integer) : activation; external;

function waitis( var r: reference; var s : semaphore) : activation; 
external;

function waitsd ( var r : reference; var s : semaphore; delay : integer ) :
activation; external;

function waitisd( var r : reference; var s : semaphore; delay : integer ) :
activation; external;

function ctrwaitid ( c : integer; delay : integer ) : activation; external;

function ctrwaitis ( c: integer; var r:reference; var s : semaphore) :
activation ; external;

function ctrwaitisd ( c: integer; var r : reference; var s : semaphore; delay : integer) :
activation; external;

procedure ___exit___rc;
external;

procedure _initpool_rc(var s : semaphore; number , size : integer);
external;


. (* end of standard environment *)
«eof»