DataMuseum.dk

top - metrics - download

    Length: 13056 (0x3300)
    Types: TextFileVerbose
    Names: »polmenv5«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »polmenv5« 

TextFileVerbose

standard_environment;
(* version : 1           *)
(* revision 5             *)
(* date : 81.03.27  , 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;
memno_type = 0..31;

activation = (a_interrupt, a_semaphore, a_delay);


base_type = packed record
lockbit : bit;
nill : bit;
moduletype : byte;
mem_no : memno_type;
nullbit : bit
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;


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


ext_message_header = record
 chain  : addr;
messagekind :  integer;
size :  integer;
 start  : addr; (* start of message data part *)
 owner  : addr;
 answer  : addr;
 msg_chain  : addr;
 stackchain  : addr;
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;

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

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

secret_vector = array(semtype) of ^ semaphore;

adamvector = array(adamsemtype) of  ^ semaphore;

system_vector = ! adamvector;

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  : ^ semaphore;
 refchain  : ^ reference;
 shadowchain  : ^ shadow;
 msg_chain  : ^ message_header;
 exit_point  : addr;
 exit_semaphore  : semaphore;
 exitref  : reference;
 secret_pointer  : ^ secret_vector;
 plinetable  : addr;
incname : alfa;
end;


ext_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  : addr;
 semchain  : addr;
 refchain  : addr;
 shadowchain  : addr;
 msg_chain  : addr;
 exit_point  : addr;
 exit_semaphore  : addr;
delaychain : addr;
 exitref  : addr;
chain1 : integer; (* inserted into bblenv *)
statistic : integer; (*appears as addr in bblenv *)
 secret_pointer  : addr;
 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) : ^ semaphore; 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;

(* now follows type definitions used in runtime processes and routines *)

const

fpabuffersize = 768; (* defines size of fpainputbuffer in boot *)
ptrbuffersize = 32; (* defines size of ptr inputbuffer in boot *)

break_appetite    = 14;
create_appetite   = 28;
initpool_appetite = 21;
link_appetite     = 13;
remove_appetite   = 16;
reservech_appetite= 13;
start_appetite    = 11;
stop_appetite     = 10;
unlink_appetite   = 14;
memtype           =  3;



type
switch_type = packed record
kind : 0..15;
module: 0..15;
address : byte
end;

regbase = integer;
  
mem_map_type = packed array (0..15) of bit;

descriptor_segment = record
descriptor_length : integer;
no_of_pages : integer;
pagesize : integer;
last_page_length : integer;
kind : integer;
name : alfa;
entry_point : addr;
exception_point : addr;
exit_point : addr;
exception_mask : integer;
last_param_offset : integer;
no_of_params : integer
end;
 
range_descriptor = record
lower_limit : integer;
upper_limit : integer
end;

dope_vector = record
r : range_descriptor;
elem_size : integer
end;


pat32 = set of 0..31;

pat16 = set of 0..15;

corearray = array(1..fpabuffersize) of byte;

(* now the routines used by the runtime processes are declared as externals *)

function addrptr(p : ^niltype) : addr;
external;

function addr_of(var a : addr) : addr;
external;

function addr_of_core(var a : corearray) : addr;
external;

function addr_of_proc(var pr : process_descriptor) : addr;
external;

procedure asgnaddrpref(var a : addr; p : ^ process_descriptor);
external;

procedure asgnaddrref(var a : addr; var r : reference);
external;

procedure asgnaddrsec(var a : addr; p : ^ secret_vector);
external;

procedure asgnrefaddr(var r : reference; a : addr);
external;

procedure asgnsemp(var p : ^ semaphore; q : ^ semaphore);
external;

procedure asgnsempaddr(var p : ^ semaphore; var address : addr);
external;


procedure assign2(var map : mem_map_type; mask : integer); external;

procedure balloc;
external;

procedure bcheck;
external;

procedure bownertest;
external;

procedure excptcall(excode : integer);
external;

procedure checkstack(appetite : integer);
external;

procedure clearlevel;
external;

procedure copywords(destination , source : addr; count : integer);
external;

procedure counttime(level : integer); external;

procedure defineptr(var pointer : addr;
start : addr;
index : integer;
var dope : dope_vector); external;

function equalref(var a , b : reference) : boolean;
external;

procedure getbyte(var result: byte; pointer : addr); external;

procedure getinteger(var result : integer; pointer : addr); external;

procedure getlfgf(var lf , gf : addr);
external;

procedure getownpu(var pu : integer); external;

procedure initextref(var r : reference ; var msg_header : ext_message_header);
external;

procedure initref(var r : reference; var msg_header : message_header);
external;

procedure initscrtref(var secretref : ^ secret_vector; address : addr);
external;

procedure jumpto(address : addr); external;

procedure linkmessage(var r : reference);
external;

procedure nextrefp(var p : ^ reference);
external;

function ptraddr(a : addr) : ^niltype;
external;

procedure putaddr(pointer , walue : addr); external;

procedure readram(var result : byte; index : integer);
external;

function refpool(var p : pool 1) : ^ pool 1;
external;

function refshadow(var sh : shadow) : ^shadow;
external;


procedure selectlevel(level : integer);
external;

procedure setregister(walue,index : integer); external;

procedure startdriver(var p : ext_incarnation_descriptor);
external;

procedure writeram(index , walue : integer);
external;

procedure writeramclr(index, walue : integer);
external;


procedure exchange(var r: reference; var p: ^message_header); external;



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