DataMuseum.dk

top - metrics - download

    Length: 10752 (0x2a00)
    Types: TextFileVerbose
    Names: »tlinker«

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

TextFileVerbose

job bbl 9 600 time 11 0 perm mini 100 1 size 92000

platonenv = set bs bblenv
(
; o linkerout
  head 1 cpu
  message link process uden test output
  pascal80 codesize.12000 spacing.12000 ,
    stack.320,
    codelist.no,
    debugenvir
  head 1 cpu
; o c
; convert linkerout
   blinker = set 1 mini
   blinker = move pass6code
  if ok.yes
    scope project blinker
  finis
)

process linker ( var linksem: semaphore);

(********************)
(*                  *)
(*   btj 80.06.04   *)
(*  linker process  *)
(* modif 81.05.22   *)
(********************)

const

maxparams    = 50; (* max number of params to a process *)
first_module = 0;
last_module  = 31;

(* definition of command values *)
bootlink     = 0;(*  descriptor_segment          result                 *)
link         = 1;(*  process_descriptor          ^ descriptor_segment   *)
unlink       = 2;(*  process_descriptor          result                 *)
lookupname   = 3;(*  name                        descriptor_segment+date*)
lookuproutine= 4;(*  ext_link_table_entry        descriptor_segment     *)
deleteroutine= 5;(*  ext_link_table_entry        result                 *)
insert       = 6;(*  descriptor_segment          result                 *)

(* definition of result values *) 
ok           = 0;
unknown      = 1;
no_room      = 2;
wrong_param  = 3;
overlap      = 4;
what         = 5;

(* definition of kinds in descriptor-segment *)
anykind      = 0;
processkind  = 1;
procedurekind= 2;
functionkind = 3;

type

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;
default_appetite : integer;
last_param_offset : integer;
end;

fixed_descriptor_segment = record
d : descriptor_segment;
no_of_params : integer
end;

link_entry = record
first_disp , last_disp : integer
end;

param_array = array ( 1 .. maxparams ) of
record
kind : integer;
size : integer;
end;

param_record = record
no_of_params : integer;
params : param_array
end;

ext_link_table_entry = record
name : alfa;
params : param_record
end;


search_modes = (new_descr, insert_descr, incarnation, routine, lookup);

var

linkertest: boolean ;

result : byte;    (* holds result of current message-processing *)

work : reference;

msg : reference;  (* holds message from surroundings *)
d   : reference;  (* work: used for lock as descriptor segment *)
p   : reference;  (* work: used for lock as process descriptor *)
d_header, p_header: message_header;  (* home-maid messages for 'd' and 'p' *)

link_table: array ( first_module .. last_module ) of link_entry;

catalog : semaphore;

i: integer;        (* used when comparing formal param-lists *)

procedure checkparams(var p1,p2 : param_record);
var
i : integer;
begin
if p1.no_of_params <> p2.no_of_params then
result := wrong_param
else
if p2.no_of_params > maxparams then
result := wrong_param
else
for i := 1 to p1.no_of_params do
if p1.params(i) <> p2.params(i) then
result := wrong_param
end;


procedure search_general (mode: search_modes);
(* searches the link-table, looking for the rigth entry  *)

var
entry: integer;  (* current index in link-table *)
name : alfa;     (* name to look for *)
next : integer;  (* next offset in module *)
lower , upper : integer; (* holds lower and upper limit for kind *)

begin

with msg^ do   (* message header of received message *)
begin

if linkertest then
begin
printtext ('search: #   ');
printaddr (start);
printnumber ( ord(mode), 3);
printnl;
end;

end;

case mode of

new_descr:
(* msg^.start points to a (new) descriptor-segment *)
begin
p^.start := msg^.start;
lock p as d_segm: descriptor_segment do
name := d_segm.name;
lower := anykind;
upper := functionkind;
end;

insert_descr:
; (* search for en empty entry, and insert this descriptor-segment *)

incarnation:
(* msg^.start points to a process-descriptor *)
begin
p^.start := msg^.start;  (* get addr of process descriptor *)
lock p as p_descr: process_descriptor do
name := p_descr.name;
lower := anykind;
upper := processkind;
end;

routine:
(* msg^.start points to a ext_link_table_entry *)
begin
p^.start := msg^.start;
lock p as ext_entry : ext_link_table_entry do
name := ext_entry.name;
lower := processkind;
upper := functionkind
end;

lookup:
begin
(* msg^.start points to a programname *)
p^.start := msg^.start;
lock p as programname : alfa do
name := programname;
lower := anykind;
upper := functionkind;
end;


end; (* case *)

if mode = insert_descr then
begin
result := ok;
with msg^.start do
begin
entry := base.mem_no;
with link_table(entry) do
begin
last_disp := disp;
if first_disp = 0 then
first_disp := last_disp
end
end
end

else

begin

if linkertest then
begin
printtext (' name=');
printtext (name);
printnumber (lower, 3);
printnumber(upper,3);
printnl;
end;

(* search for a descriptor segment  *)
(* with the specified name *)
(* and a kind between lower and upper *)

result := unknown;  (* suppose not found *)
entry  := first_module - 1;

while (entry < last_module) and (result = unknown) do
begin
entry := entry + 1;
with link_table (entry) do
if first_disp <> 0 then
begin
with d^.start do
begin
base.mem_no := entry;
disp        := first_disp
end;
next := 0;
repeat
with d^.start do
disp := uadd(disp,next);
lock d as d_segm: descriptor_segment do
begin
(* test for wanted descriptor-segment kind *)
if (lower < d_segm.kind) and (d_segm.kind <= upper) then
(* test for wanted name *)
if d_segm.name = name then
result := ok;
if (result <> ok) and (first_disp <> last_disp) then
with d_segm do
next := uadd(uadd(descriptor_length,last_page_length),umul(no_of_pages-1,pagesize));
end;
until (d^.start.disp = last_disp) or (result = ok);
end;
end; (* while *)

(* notice: if result = ok, both 'p' and 'd' are defined *)

end;

if linkertest then
begin
printtext (' entr,strt= ');
printnumber (entry, 4); printchar(',');
printaddr (d^.start);
printnl;
printtext ('result = #  ');
printnumber (result, 2);
printnl; printnl;
end;

end; (* procedure search-general *)


(* body of linker process *)
begin

for i := first_module to last_module do
link_table(i) := link_entry(0,0); (* indicates empty table *)

own.secret_pointer^(linkerstack)^.chain := addr_of(own.chain);

linkertest := false;

(* initialize the two work-references *)
(* note: only the reference-pointers and the size-field are defined *)
initref (d, d_header); d^.size := minint;
initref (p, p_header); p^.size := minint;
d^.messagekind := 0;
p^.messagekind := 0;
d^.start.base := own.chainhead.base;

(* mainloop *)

repeat (* forever *)

wait (msg, linksem);
result := ok;  (* suppose everything will be ok *)

case msg^.u1 of

bootlink:
begin
(* test for already existing *)
search_general (new_descr);
if result = ok then
(* name and kind was matching *)
(* check parameterlist        *)
(* d points to a descriptor_segment in catalog *)
(* p points to a new descriptor_segment *)
lock d as descr : record
d_segm : descriptor_segment;
params : param_record
end do
lock p as descr1 : record
d_segm : descriptor_segment;
params : param_record
end do
checkparams(descr.params,descr1.params);
if result = ok then
result := overlap (* it existed allready *)
else
(* it did'nt exist, now find empty entry and initialize *)
search_general (insert_descr);
end;

link:
begin
(* finc the wanted entry *)
search_general (incarnation);
if result = ok then
begin (* it did exist *)
(* note: 'd' points at descriptor segment *)
(* note: 'p' points at process descriptor *)
lock d as descr: record
d_segm : descriptor_segment;
params : param_record;  (* note: just in tail of descriptor segment *)
end
do
begin

(* compare the two formal parameter-lists *)

lock p as p_descr: process_descriptor do
p^.start := p_descr.param_descr_ref;  (* follow chain to formal params *)

(* note: 'p' now points at parameter description of external-declaration *)

lock p as descr1: param_record do
checkparams(descr.params,descr1)
end;

if result = ok then
(* transfer the address of descriptor segment *)
(* to process-descriptor *)
lock msg as proc: process_descriptor do
proc.process_inf_ref := d^.start;

end; (* if found in link-table *)

end; (* link *)

unlink:
begin
(* don't care... *)
end;

lookupname:
begin
(* find the wanted program *)
search_general (lookup);
if result = ok then
begin
lock p as d1 : record
descr : fixed_descriptor_segment;
date , time : integer
end do
begin
lock d as d2 : fixed_descriptor_segment do
begin
d1.descr := d2;
d^.start := d2.d.entry_point
end;
d^.start.disp := usub(d^.start.disp,16); (* get address of date and time *)
lock d as d2 : record
date , time : integer
end do
begin
d1.date := d2.date;
d1.time := d2.time
end
end
end
end;

lookuproutine:
begin
(* find the wanted entry *)
search_general(routine);
if result = ok then
begin (* it did exist *)
(* 'd' points at a descriptor_segment *)
(* 'p' points at an ext_link_table_entry *)
lock d as descr : record
d_segm : descriptor_segment;
params : param_record
end do
begin
lock p as ext_entry : ext_link_table_entry do
checkparams(descr.params,ext_entry.params);
if result = ok then
lock p as descr1 : descriptor_segment do
descr1 := descr.d_segm
end
end
end;

deleteroutine:
begin
(* don't care for the moment *)
end;

insert:
begin
pop(work,msg); (* park the top message in work *)
search_general(new_descr);
if result = ok then
lock d as descr : record
d_segm : descriptor_segment;
params : param_record
end do
lock p as descr1 : record
d_segm : descriptor_segment;
params : param_record
end do
checkparams(descr.params,descr1.params);
if result = ok then
begin
result := overlap;
push(work,msg); (* reestablish the situation *)
end
else
begin
signal(msg,catalog); (* put in catalog *)
work :=: msg
end
end; (* insert *)


otherwise
result := what; (* unknown command *)

end; (* case command code *)

msg^.u2 := result;

return (msg);

until false;  (* repeat mainloop forever *)

end.
«eof»