⟦05ff537ad⟧

TextFileVerbose

(*$5 4 0 *)
(*$5 2 0*)
(*$5 7 0*)
process boot;

type
descriptortype = packed record
pip : integer;
time : packed record
compiler_version : 0..31;
hour : 0..31;
minute : 0..63
end
end;


const

revisionno         = 6;
 

(* register stack constants *)
regsetsize         = 8;
ib                 = 6; (* ib displacement in registerset *)

wordsize           = 2;
addrsize           = 4;
first_ram_memno    = 0; (* memory module number of semaphore module *)
sem_first          = 64;  (* displacement for first of semaphore area in ram module 0 *)
monitorlevel       = 2;


auto_mem_no        = 16;

(* system semaphore array constants *)
system_semno       = 24;       (* number of system semaphores *)

headersize         = 32; (* size of headermessage in bytes *)
prom_bitmap_index  = 30; (* index of eprom bit map in ctrl processor ram *)

bootsize           = 1024;
memtype       = 3;

last_ramindex      = maxint - bootsize;

process_kind       = 1;

promlink           = 0; (* promlink command to linker *)

(* autoload kinds *)
jump               = 0;
fpa                = 2; (* autoload from fpa100 *)
ptr                = 4;
eprom              = 6;


(* answer bytes to fpa100 *)
next_block_answer  = 256 + 0;
rewind_answer      = 256 + 2;
finis_answer       = 256 + 12;
(* controlwords to fpa100 *)
repeat_interrupt   = 2;
start_read         = 3;
(* start bytes from fpa100 *)
status_block       = 249;
data_block         = 251;
(* fpa100 status words *)
receive_block_end  = 16;
transmit_block_end = 64;

nil_value          = addr(base_type(0,1,0,0,0),0);

monitorname        = 'monitor     ';
timername          = 'timer       ';
allocatorname      = 'allocator   ';
linkername         = 'linker      ';
printexceptname    = 'printexcept ';
adamname           = 'adam        ';


var

bootloadtest , inittest : boolean;
buf                : corearray;
i                  : integer;
switches           : switch_type;
index              : integer;
channel_msg        : reference;
program_msg        : reference;
buffer_msg         : reference;
ram_msg            : reference;
r                  : reference;
channel_msg_header : message_header;
program_msg_header : message_header;
bufferheader       : message_header;
ram_msg_header     : message_header;
ram_dope           : dope_vector;
prom_dope          : dope_vector;
pointer            : addr;
semref             : addr;
ram_first          : addr;
ram_index          : integer;
ram_pointer        : addr;
save_ram_first     : addr;
save_ram_pointer   : addr;
save_ram_index     : integer;
pointer_move       : boolean := true;

bootmoduleno       : byte;

test               : boolean;
revisionerror      : boolean := false;

initboottop        : addr; (* top of initbootcode = first of boot descriptorsegment *)
bootlevel          : integer;

prom_first         : addr;
program_index      : integer;
program_pointer    : addr;
program_top        : addr;

prom_bitmap        : mem_map_type;


common             : shadow;

status_in          : integer;
status_out         : integer;
block_answer       : integer := rewind_answer;
block_type         : integer;
continue_read      : boolean;
descrsize          : integer;
descrwords         : integer;
codewords          : integer;
bufferindex        : integer;
last_in_buffer     : integer;


process monitor(var sem : semaphore); external;

process timer(var delay , sem : semaphore); external;

process allocator(var sem1, sem2 : semaphore); external;

process linker(var sem : semaphore); external;

process adam(var sem : semaphore); external;

process printexcept;
external;

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

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

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

procedure initscrtref = stvsd0(var s : ^ secret_vector; a : addr);
external;

function uadd(a,b : integer) : integer;
external;

function umod(a,b : integer) : integer;
external;

function umul(a,b : integer) : integer;
external;

function udiv(a,b : integer) : integer;
external;


procedure printchar(ch:char);
begin
writeram(8,ord(ch));
end;

procedure printhex (val: integer);
type convarr = array (0..15) of char;
const hextab = convarr('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
var ch1: integer;
begin
if val < 0 then
begin
ch1 := 8;
val := val - minint;
end
else
ch1 := 0;

printchar (hextab(ch1 + val div (16*16*16)));
printchar (hextab(val div (16*16) mod 16));
printchar (hextab(val div 16      mod 16));
printchar (hextab(val             mod 16));
end;

procedure printaddr( a : addr);
begin
with a.base do
printhex((((- lockbit * 2 + nill) * 256 + moduletype) * 32 + mem_no) * 2 + nullbit);
printchar('.');
printhex(a.disp)
end;

procedure printtext (text:alfa);
var i: integer;
begin
i := 1;
while text(i) <> '#' do
begin
printchar(text(i));
if i = alfalength then text(i) := '#' else i := i + 1;
end;
end;

procedure printnl;
var i: integer;
begin
printchar (cr); printchar (nl);
for i := 1 to 10 do printchar(del);
end;

procedure setexcept;
external;

procedure except;
label rep;

begin
with own do
begin
printnl;
printtext ('*** #       ');
printtext ('exception: #');
printhex (exception_mask);
printtext (' at: #      ');
printaddr(exic);
printnl;
end;
rep:goto rep;
end;

procedure platoninit;
begin
setexcept; except;
end;


procedure control(control_word : integer; var ch_msg : reference);
external;

procedure controlclr(control_word : integer; var ch_msg : reference);
external;

procedure inword(var word : integer; var ch_msg : reference);
external;


procedure sense(var status_in : integer; status_out : integer; var ch_msg : reference);
external;

procedure outword(word : integer; var ch_msg : reference);
external;

procedure movepointer(
offset: integer;
dope: dope_vector;
var first: addr;
var index: integer;
var pointer: addr
);

var
i : integer;

begin
if offset >= 0 then
begin (* test for overflow into next module *)
if dope.r.upper_limit - offset < index then
begin
first.base.mem_no := first.base.mem_no + 1;
index := dope.r.lower_limit + 1 (* promword *);
offset := 0;
end;
end;

if pointer_move then
index := index + offset;
defineptr (pointer, first, index, dope);

end; (* procedure movepointer *)


procedure moveramptr (offset: integer);
label rep;
begin
  if ram_first.base.mem_no = bootmoduleno then
  ram_dope.r.upper_limit := last_ramindex;
movepointer (offset, ram_dope, ram_first, ram_index, ram_pointer);
if ram_first.base.mem_no = bootmoduleno + 1 then
begin
printnl;
printtext('*** buy more'); printtext(' memory !!!!');
rep: goto rep
end;
end;

procedure move_program_pointer (offset: integer);
begin
movepointer (offset, prom_dope, prom_first, program_index, program_pointer);
end;

   procedure reserveprom(size : integer);
   begin
     pointer_move := false;  (* just test room *)
     move_program_pointer(size - 1);
     pointer_move := true;
  end;

procedure takeram (size: integer);
begin
moveramptr (size);
ram_msg_header.start := ram_pointer;
end;

procedure reserveram (size: integer);
begin
pointer_move := false;  (* i.e. just test room *)
takeram (size - 1);     (* make sure last word is addressable *)
pointer_move := true;
end;

procedure ptrblock;
begin
sense (status_in, status_out, channel_msg);
controlclr(0,channel_msg);
inbyteblock (last_in_buffer, 0, ptrbuffersize - 1, buffer_msg, channel_msg);
end;

procedure fpablock;
begin

outword (block_answer, channel_msg);
controlclr(repeat_interrupt, channel_msg);
sense (status_in, status_out, channel_msg);

if status_in <> transmit_block_end then
block_answer := rewind_answer  (* prepare repetition on: reset or autoload etc *)
else
if block_answer <> finis_answer then
begin (* don't read after finis-answer has been sent *)

controlclr (start_read, channel_msg);
inword (block_type, channel_msg);
controlclr (repeat_interrupt, channel_msg);
inbyteblock (last_in_buffer, 0, fpabuffersize - 1, buffer_msg, channel_msg);
controlclr (repeat_interrupt, channel_msg);
sense (status_in, status_out, channel_msg);

if status_in <> receive_block_end then
block_answer := rewind_answer
else
if (block_type = status_block) and (last_in_buffer = 8) then
block_answer := next_block_answer
else
if block_type <> data_block then
block_answer := rewind_answer;
end;

if (block_type = data_block) and (block_answer = next_block_answer) then
begin
if last_in_buffer > 15 then
last_in_buffer := last_in_buffer - 15
else
begin
last_in_buffer := 0;
block_answer := finis_answer;
end;
end
else
begin
last_in_buffer := 0;
continue_read := false; (* because starting all over again *)
end;

end; (* procedure fpablock *)

function getbyte: byte;
begin
if bufferindex >= last_in_buffer then
if continue_read then
begin
selectlevel(bootlevel);
if switches.kind = ptr then ptrblock
else fpablock;
bufferindex := 0;
end;

if bufferindex < last_in_buffer then
begin
bufferindex := bufferindex + 1;
getbyte := buf (bufferindex);
end
else
getbyte := 0;  (* simulate byte *)
end; (* procedure getbyte *)

function getword : integer;
begin
getword := uadd(umul(getbyte,256),getbyte)
end;

procedure prepare_input;
begin
continue_read := true;
bufferindex := 1;
last_in_buffer := bufferindex;
if switches.kind = ptr then
while getbyte = 0 do;  (* skip until significant start *)
end;

procedure reset_input;
begin
prepare_input;
ram_first   := save_ram_first;
ram_pointer := save_ram_pointer;
ram_index   := save_ram_index;
end;

procedure terminate_input;
begin
if switches.kind = fpa then
outword(finis_answer,channel_msg);
end;


procedure bootcreate(proces : processrec;
var sh : shadow;
var q : descriptor_segment);
(* entry : ram_pointer and ramindex equals first of stack *)
(* exit  :     -        -     -       -    top   -    -   *)
const
stopstate = -1;
var
storage : integer;
size_of_incdescr : integer;
size_of_params : integer;
begin
storage := q.default_appetite;
size_of_params := proces.size_of_params div wordsize;
size_of_incdescr := q.last_param_offset div wordsize - size_of_params;
reserveram (storage);

if inittest then
begin
printtext(', stack=#   '); printaddr (ram_pointer);
end;

lock sh.r as p : ext_incarnation_descriptor do
with p do
begin
pu := 0;
level := 0;
incstate := stopstate;
activequeue := addr_of(chain);
chainhead := nil_value;
exception_point := q.exception_point;
exic := addr(base_type(0,0,0,0,0),0);
dumpps := 0;
dumpsf := ram_pointer.disp + 1;
entry_point := q.entry_point;
timer := 0;
asgnaddrpref(processref,proces.processref);
semchain := nil_value;
refchain := nil_value;
shadowchain := nil_value;
msg_chain := nil_value;
exit_point := q.exit_point;
exit_semaphore := nil_value;
delaychain := nil_value;
exitref := nil_value;
statistic := nil_value;
asgnaddrsec(secret_pointer,own.secret_pointer);
incname := q.name;
(* set pointer to destination for actual parameters of this incarnation *)
moveramptr(size_of_incdescr);
(* copy actual params from boot stack to stack of child *)
copywords(ram_pointer,proces.firstparam,size_of_params);
moveramptr(size_of_params - 1);
dumplu := ram_pointer.disp + 1;
(* move ram_pointer to last of this stack *)
moveramptr(storage - (size_of_incdescr + size_of_params));
dumplm := ram_pointer.disp + 1;
maxstack := dumplm;

with proces.processref^ do
incarnationcount := incarnationcount + 1; 

(* ram_pointer := top of stack *)
moveramptr(1);

if inittest then
begin
printtext(' top=#      '); printaddr (ram_pointer);
end;

end
end; (* bootcreate *)

procedure bootrun(proces : processrec; var sh : shadow; priority : integer;
var q : descriptor_segment);
const
start_command = 1;
begin
bootcreate(proces,sh,q);
with sh.r^ do
begin
u1 := start_command;
u3 := priority + 128;
end;
signal(sh.r,own.secret_pointer^(monitorsem)^);
wait(sh.r, own.exit_semaphore);
end;



procedure get_memory_map(var map : mem_map_type; first : integer);
var
map0, map1 : byte;
begin
readram(map0,first);
readram(map1,first + 1);
assign2(map,uadd(umul(map0,256),map1))
end;


procedure get_switches(var sw : switch_type);
const
rtc_level_index = 0;
switch0_index = 10;
switch1_index = 11;
var
switch0 : byte;
switch1 : byte;
begin
readram(switch0,switch0_index);
readram(switch1,switch1_index);
sw.kind := (switch0 div 16)mod 8;
sw.module := switch0 mod 16;
sw.address := switch1;
(* kill rtc interrupts *)
writeram(rtc_level_index,0);
end;

function test_basic_process(var msg : reference) : boolean;
forward;


procedure skip_program;
   var
   codewords : integer;
begin
lock program_msg as p: descriptor_segment do
with p do
begin
move_program_pointer (descriptor_length div wordsize);
codewords := (no_of_pages - 1) * (pagesize div wordsize) + ( last_page_length + 1) div wordsize;
end;
reserveprom(codewords);
program_msg_header.start := program_pointer;
lock program_msg as descriptor : descriptortype do
if descriptor.time.compiler_version <> revisionno then
begin
printtext('****warning:');
printtext(' versionerro');
printtext('r at #      ');
printaddr(program_pointer);
printnl;
revisionerror := true
end;
   move_program_pointer(codewords);
end;


procedure include_one_program;
const
ok = 0;
begin
program_msg_header.start := program_pointer;
if not test_basic_process(program_msg) then
begin
program_msg^.u1 := promlink;
signal(program_msg,own.secret_pointer^(linkersem)^);
wait(program_msg,own.exit_semaphore);
if program_msg^.u2 <> ok then
begin
printtext('****warning:'); printtext(' link result');
printhex(program_msg^.u2);
printtext(' at #'); printaddr(program_pointer);
printnl;
end;
end;
(* move program_pointer to next program descriptor *)
skip_program;
end;


procedure include_programs;
var descrsize: integer;
begin
repeat
getinteger (descrsize, program_pointer);
if (descrsize > 0) and (descrsize <> #h5555) then
include_one_program;
until (descrsize <= 0) or (descrsize = #h5555);
end;


procedure init_ext_header(var msg : ext_message_header;
kind , msize : integer; mstart : addr);
begin
with msg do
begin
chain := nil_value;
owner := nil_value;
answer := nil_value;
msg_chain := nil_value;
stackchain := nil_value;
messagekind := kind;
size := msize;
start := mstart;
end;
end;

procedure initheader(var msg : message_header;
kind,msize : integer; mstart : addr);
begin
with msg do
begin
owner := ref(own.exit_semaphore);
answer := owner;
messagekind := kind;
size := msize;
start := mstart;
end;
end;


procedure send_message_header(var sem : semaphore);
begin
reserveram (headersize div wordsize);
lock ram_msg as p : ext_message_header do
begin
init_ext_header(p,0,0,nil_value);
initextref(r,p);
with r^ do
begin
owner := ref(sem);
answer := owner;
end;
signal(r,sem);
end;
takeram (headersize div wordsize);
end;


function test_basic_process(var msg : reference): boolean;
const
runstate = 0;
linkerpriority = 1;
timerpriority  = 1;
priority       = 1;
begin
test := false;
lock msg as p : descriptor_segment do
begin

if inittest then
begin
printaddr(msg^.start);
printtext(': #         ');
printtext(p.name);
printhex(p.kind);
end;

if p.kind = process_kind then
begin
if p.name=monitorname then
begin
bootcreate(monitor(own.secret_pointer^(monitorsem)^),common,p);
lock common.r as q : ext_incarnation_descriptor do
begin
q.level := monitorlevel;
q.incstate := runstate;
startdriver(q)
end;
test := true;
end
else
if p.name=timername then
bootrun(timer(own.secret_pointer^(timersem)^,
own.secret_pointer^(monitorsem)^),
common,timerpriority,p)
else
if p.name = allocatorname then
bootrun(allocator(own.secret_pointer^(allocsem)^,
own.secret_pointer^(deallocatorsem)^),
common,priority,p)
else
if p.name = linkername then
bootrun(linker(own.secret_pointer^(linkersem)^),common,linkerpriority,p)
else
if p.name = printexceptname then
bootrun(printexcept,common,priority,p)
else
if p.name = adamname then
bootrun(adam(own.secret_pointer^(opsem)^),common,priority,p);
end;
end;

if inittest then
printnl;

test_basic_process := test;
end;


procedure bootload;
begin
printnl;
printtext ('load from # ');
case switches.kind of
fpa: begin
printtext('fpa in #    ');
printhex(switches.address)
end;
ptr: begin
printtext('ptr in #    ');
printhex(switches.address)
end;
eprom: begin
selectlevel(bootlevel);
 printtext('eprom#      ');
end
otherwise
printtext('*** undefine'); printtext('d switchkind');
printhex(switches.kind)
end;

printnl;

initheader (bufferheader, 16384, fpabuffersize div wordsize, addr_of_core(buf));
initref (buffer_msg, bufferheader);

initheader (channel_msg_header, minint + switches.address, 0, nil_value);

prepare_input;
save_ram_first      := ram_first;
save_ram_pointer := ram_pointer;
save_ram_index   := ram_index;

if (switches.kind = ptr) or (switches.kind = fpa) then
repeat

if not continue_read then reset_input;

repeat

descrsize := getword;

if (descrsize > 0) and continue_read then
begin
printchar('.');
(* reserve room for descriptor-segment, and read it *)
descrwords := descrsize div wordsize;
reserveram (descrwords);

if bootloadtest then
begin
printtext('descr=#     '); printhex (ram_pointer.disp);
printtext(' size=#     '); printhex (descrwords);
end;

lock ram_msg as core: array(1..maxint) of integer do
begin
core (1) := descrsize;
for i := 2 to descrwords do
core (i) := getword;
end;

if continue_read then
begin
lock ram_msg as p: descriptor_segment do
with p do
codewords := (no_of_pages - 1) * (pagesize div wordsize) + (last_page_length + 1) div wordsize;
takeram (descrwords);
reserveram (codewords);

if bootloadtest then
begin
printtext (' code=#     '); printaddr (ram_pointer);
printtext (' size=#     '); printhex (codewords);
end;

lock ram_msg as core: array(1..maxint) of integer do
for i := 1 to codewords do
core(i) := getword;

takeram (codewords);
end;

if bootloadtest then
printnl;


end;

until descrsize <= 0;

reserveram(1);
lock ram_msg as stopword : integer do
stopword := -1;
takeram(1);

until continue_read;

terminate_input;

end; (* procedure bootload *)


(*******************************************************)
(*                                                     *)
(*          mainprogram                                *)
(*                                                     *)
(*******************************************************)

begin

platoninit;

bootloadtest := false;
inittest := false;

initboottop := own.chainhead; (* pick up first of boot descriptor passed from initboot *)

own.maxstack := -1;
own.activequeue := addr_of(own.chain);

bootmoduleno := own.activequeue.base.mem_no;


(* reset channel 0..123 *)
initref(channel_msg,channel_msg_header);
for i := 0 to 123 do
begin
initheader(channel_msg_header,minint + i,0,nil_value);
control(0,channel_msg);
end;

(* reset semaphore area *)

own.exit_semaphore.chain := nil_value;

ram_dope := dope_vector(range_descriptor(0,maxint),wordsize);

prom_dope := ram_dope;

ram_first := addr(base_type(0,0,memtype,first_ram_memno,0),0);
ram_index := 0;


get_switches(switches);

bootlevel := switches.address mod 128;

takeram(sem_first div wordsize);

(* init semaphores to passive *)
for i := 1 to system_semno do
begin
putaddr(ram_pointer,nil_value);
   takeram(addrsize div wordsize);
end;
initscrtref(own.secret_pointer,ram_pointer);
   for i := 1 to system_semno do
   begin
      semref := ram_pointer;
      semref.disp := semref.disp - addrsize * system_semno;
      putaddr(ram_pointer,semref);
      takeram(addrsize div wordsize);
   end;

(* init ram-headers etc *)
initheader(ram_msg_header,16384,minint,ram_pointer);
initref(ram_msg,ram_msg_header);
if switches.kind = jump then
begin
with pointer do
begin
base := base_type(0,0,memtype,0,0);
base.mem_no := switches.module;
disp := switches.address
end;
jumpto(pointer);
end;


initref(common.r,ram_msg_header);

initheader(program_msg_header,16384,minint,initboottop);
initref(program_msg,program_msg_header);

get_memory_map(prom_bitmap,prom_bitmap_index);

bootload;
program_top := ram_pointer;


program_pointer := initboottop;
prom_first      := initboottop;
prom_first.disp := 0;
program_index := program_pointer.disp div wordsize; (* disp must be > 0 *)
(* now program_pointer is first of boot descriptor segment *)

(* program_msg_header is initialized by the initheadercall *)
skip_program;
(* now program_pointer is top of bootprogram *)

include_programs;

(* include autoloaded programs *)
prom_first := save_ram_first;
program_pointer := save_ram_pointer;
program_index := save_ram_index;

while program_pointer <> program_top do
begin
include_programs;
move_program_pointer(1); (* skip stopword *)
end;

i := auto_mem_no;
while i < 32 do
begin
(* move pointers to start of module 'i' *)
prom_first.base.mem_no := i;
program_pointer := prom_first;
program_pointer.disp := 2;
program_index := 1;
if prom_bitmap (i - auto_mem_no) = 1 then

(* note: prom containing boot itself, must be handled specially *)
if initboottop.base.mem_no <> i then
include_programs;
i := prom_first.base.mem_no + 1;
end; (* for loop *)

(* at this point ram_msg_header describes the rest of *)
(* free ram in module *)
(* adjust ram_pointer so that ram_pointer.disp mod headersize = 0 *)
takeram(headersize div wordsize - ram_index mod(headersize div wordsize));


(* now the rest of free ram is an integral number of message headers *)


send_message_header(own.exit_semaphore);  (* trick to get correct type of answer sem *)
wait(r,own.exit_semaphore);

(* signal rest of ram memory to allocator semaphore *)
with r^ do
begin
answer := own.secret_pointer^(stopsem);
owner := answer;
start := addr(base_type(0,0,memtype,first_ram_memno,0),0);;
size := minint;
u1 := 0 * 4 + 2;
u2 := ram_pointer.base.mem_no;
i := ram_pointer.disp;
u3 := udiv(i,256);
u4 := umod(i,256);
end;
signal(r,own.secret_pointer^(deallocatorsem)^);

if not revisionerror then
begin
(* set ra bit in my own registerset to release registerset *)
setregister(-1 , bootlevel * regsetsize + ib);
clearlevel;
end;

end  (* boot *)
.
«eof»
DataMuseum.dk

RC3500

⟦05ff537ad⟧ TextFileVerbose

Derivation

TextFileVerbose
