|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 19968 (0x4e00)
Types: TextFile
Names: »tcreatetask«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦ef5fa0e68⟧ »jtas«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦ef5fa0e68⟧ »jtas«
└─⟦this⟧
createtask
begin
! call:
<task name> = createtask <program name>
createtask creates an internal process, loads fp and makes it start
<program name>, which is supposed to execute the "initialization code",
load all "effective code" of <program name> and send a message to
createtask. the code is then written on a file named <task name>.
if execution is stopped in an error situation (by 'fatal_error') the
mode bis are ok.no warning.yes and bit 11 is unchanged. otherwise bit
11 is cleared.
version 3 14.11.80 !
!sections 10
\f
! p r o c e d u r e d e c l a r a t i o n s !
! main procedures !
procedure read_command (.w3.; w2);
procedure initialize (.w3.);
procedure create_child (.w3.);
procedure run_program (.w3.);
procedure dump_core (.w3.);
! common procedures !
procedure fatal_error (.w3.; w2; w1; w0);
! p r o c e d u r e d e c l a r a t i o n s e n d !
\f
! d a t a d e c l a r a t i o n s p a g e 1 !
incode
word
task_size_sg, ! task size in segments !
task_size_hw, ! - halfwords !
task_free_core, ! free core in task !
task_entry, ! entry address of task !
fp_start, ! fp start (of parent process) !
output_on := 1, ! = 0 if no output is wanted !
ch_first_log_addr, ! first log. addr. of child !
ch_first_addr, ! first addr. of child !
ch_size, ! size of child process !
ch_prd_addr, ! process descr. addr. for child !
c_look_up_result; ! result of 'c' look up !
text (12) prog_name; ! input file name !
text (12) task_name; ! output file name !
text (12) ch_name; ! child process name !
text (12) c_name := "c"; ! name of 'c' entry !
text (17) start_text := "'10'createtask start";
text (15) task_text := " - task started";
text (22) free_text := " - free core in task: ";
text ( 3) hw_text := " hw";
text (16) end_text := "createtask end'10''10'";
array (0:9) c_entry_tail of word; ! for entry tail of 'c' !
! d a t a d e c l a r a t i o n s e n d !
\f
! s t a r t m a i n p r o g !
begin
! w2 points to start of fp command stack, w3 to program name !
if w0 := (w3).byte <> 6 ! "=" ! then output_on := w3 := 0;
ch_first_addr := w1; ! = first free byte !
fp_start := w2; ! = top free byte !
write(.w3., w0:=address(start_text)); w2 := 10; fp(33-2); ! end current output !
! read and test calling command !
read_command (.w3., w2:=fp_start);
! set task_size_sg, task_size_hw, ch_first_log_addr and ch_size !
initialize (.w3.);
! store entry of 'c' - it is changed by fp in child !
c_entry_tail(w1:=0); w3 := address(c_name);
monitor(42); ! look up entry ! c_look_up_result := w0;
! create child process - load and start fp and set ch_prd_addr !
create_child (.w3.);
write(.w3., w0:=address(task_text)); w2 := 10; fp(33-2); ! end current output !
! run algol program - set task_entry and task_free_core !
run_program (.w3.);
write(.w3., w0:=address(free_text));
write(.w3., w0:=task_free_core);
write(.w3., w0:=address(hw_text)); w2 := 10; fp(33-2); ! end current output !
! dump loaded core image !
if w3 := output_on <> 0 then dump_core (.w3.);
! reset 'c' entry !
c_entry_tail(w1:=0); w3 := address(c_name);
monitor(48); ! remove entry !
if w0 := c_look_up_result = 0 then monitor(40); ! create entry !
write(.w3., w0:=address(end_text));
! clear mode bit 11 - supposed to be set by algoltask !
w0 := (w3:=fp(51)).word; if w1 := w0 and 4096 <> 0 then (w3).word := w0 xor 4096;
end;
! m a i n p r o g e n d !
\f
! p r o c e d u r e r e a d _ c o m m a n d !
body of read_command
begin
! tests fp command and copies names and options to command arrays
w2 call : ptr to start of command stack.
return : ptr to word after commands read.
w0,w1 return : undef. !
incode
ref return;
begin return := w3;
if w3 := b.output_on <> 0 then ! read task name !
begin
! test text follows (-,10) !
if w0,=(w2+1).byte <> 10 then fatal_error(.w3., w2:=1, w1:=0, w0);
w3 :=address(b.task_name);
(w3).double := f1 := (w2+1).double; (w3+4).double := f1 := (w2+4).double; w2 + 4;
end;
! test text follows (-,10) !
if w0,=(w2+1).byte <> 10 then fatal_error(.w3., w2:=1, w1:=0, w0);
w2 + 9; ! skip byte and 'algoltask1' !
! test space - text follows (4,10) !
if w0:=(w2).word <> w1:= 4 lshift 12 + 10 then fatal_error(.w3., w2:=1, w1:=0, w0);
w3 :=address(b.prog_name);
(w3).double := f1 := (w2+2).double; f1 := (w2+4).double; w1 or 10;
(w3+4).double := f1; w2 + 4;
! no options (yet) !
if w0:=(w2).byte <> -2 ! = ")" ! then
if w0 <> -4 ! = end of stack ! then
if w0 <> 2 ! = nl ! then fatal_error(.w3., w2:=1, w1:=0, w0);
w2 + 2;
w3 := return;
end;
end;
! p r o c e d u r e r e a d _ c o m m a n d e n d !
\f
! p r o c e d u r e i n i t i a l i z e p a g e 1 !
body of initialize
begin
! reads task size and first logical address in tosssysdef1/2 entries.
sets ch_size and test if we have room for the task (with fp etc).
w0,w1,w2 return : undef. !
incode
ref return;
array (0:9) entry_tail of word;
text (12) sys_def_1 := "tosssysdef1";
text (12) sys_def_2 := "tosssysdef2";
begin
return := w3;
! read task size in tosssysdef1 entry !
entry_tail (w1:=0);
w3 := address(sys_def_1);
monitor(42); ! look up entry !
if w0 <> 0 then fatal_error(.w3., w2:=4, w1:=42, w0);
b.task_size_sg := w0 := (w1+12).byte;
w0 * 512; b.task_size_hw := w0;
! read first logical address in tosssysdef2 entry !
entry_tail (w1:=0);
w3 := address(sys_def_2);
monitor(42); ! look up entry !
if w0 <> 0 then fatal_error(.w3., w2:=4, w1:=42, w0);
b.ch_first_log_addr := w0 := (w1+12).word;
\f
! p r o c e d u r e i n i t i a l i z e p a g e 2 !
! test if we have enough room !
! child size := task size + 1536 (fp) + 1024 (in/out) + 12 (fp commands) - 6 (end words) !
b.ch_size := w1 := b.task_size_hw + 2566;
w0 := b.ch_firstaddr + w1; ! top of child !
if w0 > b.fp_start then fatal_error(.w3., w2:=3, w1:=0, w0);
! generate wrk-name for task process !
w3 := address(b.ch_name);
monitor(68);
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=68, w0);
w3 := return;
end;
end;
! p r o c e d u r e i n i t i a l i z e e n d !
\f
! p r o c e d u r e c r e a t e _ c h i l d p a g e 1 !
body of create_child
begin
! creates a child process, loads fp and starts it.
w0,w1,w2 return : undef. !
incode
ref return, mtr_buff_addr;
word fp_size, fp_entry;
array (0:9) parameters of word;
array (0:7) mess_buff of word := 0 0 0 0 0 0 0 0;
text (12) fp_name := "fp";
begin
return := w3;
! create child process !
parameters(w1:=0); w3 := (w2:=fp(16)).word; ! own prd. addr. !
(w1).word := w0 := b.ch_first_addr; ! first address !
(w1+2).word := w0 + b.ch_size; ! top address !
(w1+2).byte := w0 ,= (w3+26).byte - 2; ! buffer claim !
(w1+1).byte := w0 ,= (w3+1).byte; ! area claim !
(w1+1).word := w0 := 0; ! int. claim, funct. mask !
(w1+2).word := w0 := (w3+5).word; ! protection reg./key !
(w1+2).word := w0 := (w3+40).word; ! bases !
(w1+2).word := w0 := (w3+2).word; ! = !
(w1+2).word := w0 := (w3-6).word; ! parent !
(w1+2).word := w0 := (w3+2).word; ! bases !
parameters(w1:=0); w3 := address(b.ch_name);
monitor(56); ! create internal process !
if w0 <> 0 then fatal_error(.w3., w2:=6, w1:=56, w0);
! get child process description address !
monitor(4); ! process description !
if w0 = 0 then fatal_error(.w3., w2:=0, w1:=4, w0);
b.ch_prd_addr := w0;
\f
! p r o c e d u r e c r e a t e _ c h i l d p a g e 2 !
! lookup fp - get size and entry address !
parameters(w1:=0); w3 := address(fp_name);
monitor(42); ! look up entry !
if w0 <> 0 then fatal_error(.w3., w2:=12, w1:=42, w0);
parameters(w3:=9);
fp_size := w0 := (w3).word; fp_entry := w0 ,= (w3-1).byte;
! read-message into mess buffer !
mess_buff(w3:=0);
(w3).word := w2 := 3 lshift 12; ! operation = input !
(w3+2).word := w2 := b.ch_first_addr; ! first byte !
(w3+2).word := w2 + fp_size; ! top byte !
(w3+2).word := w2 :=0; ! segment no. !
! start reading of fp !
mess_buff(w1:=0);
w3 := address(fp_name);
monitor(16); ! send message !
if w2 = 0 then fatal_error(.w3., w2:=5, w1:=16, w0:=0);
monitor(18); ! wait answer !
if w0 <> 1 then fatal_error(.w3., w2:=12, w1:=18, w0);
! set child registers !
parameters(w1:=0);
(w1).word := w0 := (w2:=fp(16)).word; ! own prd. addr. !
(w1+2).word := w0;
(w1+2).word := w0;
(w1+2).word := w0 := b.ch_prd_addr;
(w1+2).word := w0 := 0;
w0 := b.ch_first_addr; (w1+2).word := w0 + fp_entry;
parameters(w1:=0); w3 := address(b.ch_name);
monitor(62); ! modify child process !
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=62, w0);
\f
! p r o c e d u r e c r e a t e _ c h i l d p a g e 3 !
! address base := first child addr. - first log. child addr. !
w1 := b.ch_first_addr - b.ch_first_log_addr;
monitor(98); ! change address base !
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=98, w0);
monitor(58); ! start internal process !
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=58, w0);
mess_buff(w1:=0);
monitor(20); ! wait message !
if w2 = 0 then fatal_error(.w3., w2:=5, w1:=20, w0);
if w0 <> b.ch_prd_addr then fatal_error(.w3., w2:=0, w1:=20, w0);
mtr_buff_addr := w2;
! is fp asking for input !
if w0 := (w1).byte <> 3 then fatal_error(.w3., w2:=2, w1:=0, w0);
! send <program name> to fp !
w2 := (w1+2).word - b.ch_first_log_addr + b.ch_first_addr - 2;
w3 := address(b.prog_name) - 2;
for w1 := 1 step 1 upto 7 do (w2+2).word := w0 := (w3+2).word;
mess_buff(w2:=0);
(w2).word := w3 := 0;
(w2+2).word := w3 := 8; ! size in hw !
(w2+2).word := w0 := 12; ! size in char !
(w2+2).word := w3 := 0;
w0 := 1; ! result = normal answer !
mess_buff(w1:=0);
w2 := mtr_buff_addr;
monitor(22); ! send answer !
w3 := return;
end;
end;
! p r o c e d u r e c r e a t e _ c h i l d e n d !
\f
! p r o c e d u r e r u n _ p r o g r a m p a g e 1 !
body of run_program
begin
! waits for a message from set_entry (or fp if something vent wrong).
if message is "ok" the task is ready to be dumped, otherwise an
error message is written.
w0,w1,w2 return : undef. !
incode
ref return, text_start;
word mtr_buff_addr;
array (0:7) mess_buff of word;
array (0:7) mess_buff_1 of word;
array (0:5) process_name of word;
begin
return := w3;
mess_buff(w1:=0);
process_name(w3:=0);
monitor(20); ! wait message !
if w2 = 0 then fatal_error(.w3., w2:=5, w1:=20, w0);
if w0 <> b.ch_prd_addr then fatal_error(.w3., w2:=0, w1:=20, w0);
mtr_buff_addr := w2;
! stop_child !
monitor(60); ! stop intternal process !
if w2 = 0 then fatal_error(.w3., w2:=5, w1:=60, w0:=0);
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=60, w0);
mess_buff_1(w1:=0);
monitor(18); ! wait answer !
\f
! p r o c e d u r e r u n _ p r o g r a m p a g e 2 !
! send dummy answer to received message !
w2 := mtr_buff_addr;
w0 := 2; ! dummy answer !
monitor(22); ! send answer !
! remove child process !
monitor(64); ! remove process !
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=64, w0);
mess_buff(w2:=0); w0 ,= (w2).byte;
if w0 = 5 then ! output message !
begin
w1 := b.ch_first_log_addr - b.ch_first_addr;
w0 := (w2+2).word - w1; text_start := w0;
if w0 >= w3 := b.ch_first_addr then if w0 <= w3 + b.ch_size then
begin
w3 := (w2+2).word - w1 + 2; (w3).byte := w1 := 0;
write(.w3., w0:=text_start);
fatal_error(.w3., w2:=14, w1:=0, w0);
end;
end;
if w0 = 101 then ! error message from set_entry !
begin
if w0 := (w2+2).word = 1 then w2 := 7 else w2 := 8;
fatal_error(.w3., w2, w1:=0, w0);
end;
if w0 <> 100 then fatal_error(.w3., w2:=9, w1:=0, w0);
! else task run ok !
b.task_free_core := w0 := (w2+2).word;
b.task_entry := w0 := (w2+2).word;
w3 := return;
end;
end;
! p r o c e d u r e r u n _ p r o g r a m e n d !
\f
! p r o c e d u r e d u m p _ c o r e p a g e 1 !
body of dump_core
begin
! writes code image on file with name in b.task_name.
w0,w1,w2 return: undef. !
incode
ref return;
array (0:9) entry_tail of word := 0 0 0 0 0 0 0 0 0 0;
array (0:7) mess_buff of word := 0 0 0 0 0 0 0 0;
begin
return := w3;
entry_tail(w1:=0);
(w1).word := w3 := b.task_size_sg;
w3 := address(b.task_name);
monitor(52); ! create area process !
if w0 = 3 then ! entry does not exist !
begin
monitor(40); ! create entry !
if w0 = 4 then fatal_error(.w3., w2:=10, w1:=40, w0);
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=40, w0);
monitor(52); ! create area process !
end;
if w0 = 1 then fatal_error(.w3., w2:=11, w1:=52, w0);
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=52, w0);
monitor(8); ! reserve area process !
if w0 <> 0 then ! process cannot be reserved !
begin
monitor(40); ! create entry !
if w0 = 4 then fatal_error(.w3., w2:=10, w1:=40, w0);
if w0 <> 0 then if w0 <> 3 then fatal_error(.w3., w2:=0, w1:=40, w0);
monitor(52); ! create area process !
if w0 = 1 then fatal_error(.w3., w2:=11, w1:=52, w0);
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=52, w0);
monitor(8); ! reserve area process !
end;
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=8, w0);
\f
! p r o c e d u r e d u m p _ c o r e p a g e 2 !
entry_tail(w2:=0);
f1 := (w1:=108).double lshift 5; (w2+10).word := w0; ! short clock !
(w2+6).byte := w0 := 17; ! contents key !
(w2+2).word := w0 := b.task_size_sg; ! load length !
entry_tail(w1:=0);
monitor(44); ! change entry !
if w0 <> 0 then fatal_error(.w3., w2:=0, w1:=44, w0);
! dump task !
! write-message into mess buffer !
mess_buff(w3:=0);
(w3).word := w2 := 5 lshift 12; ! operation = output !
(w3+2).word := w1 := b.ch_first_addr + 1536; ! first byte !
(w3+2).word := w1 + b.task_size_hw; ! top byte !
(w3+2).word := w2 :=0; ! segment no. !
! set last word of dump !
(w1-2).word := w0 := b.task_entry;
! start writing !
mess_buff(w1:=0); w3 := address(b.task_name);
monitor(16); ! send message !
if w2 = 0 then fatal_error(.w3., w2:=5, w1:=16, w0:=0);
monitor(18); ! wait answer !
if w0 <> 1 then fatal_error(.w3., w2:=13, w1:=18, w0);
w3 := return;
end;
end;
! p r o c e d u r e d u m p _ c o r e e n d !
\f
! p r o c e d u r e f a t a l _ e r r o r p a g e 1 !
body of fatal_error
begin
! writes an error message and stops execution
w2 call : if > 0 error text number
w1 call : if > 0 monitor call number
w0 call : if w1 > 0 monitor call result !
incode
word error_no, mtr_call_no, result;
text (4) error_text := "*** ";
text (24) fp1_text_1 := "error in fp command line";
text (26) fp2_text_2 := "fp trouble in childprocess";
text (12) core_text_3 := "lack of core";
text (21) sysdef_text_4:= "tosssysdef1/2 problem";
text (21) buff_text_5 := "buffer claim exceeded";
text (23) int_text_6 := "internal process claims";
text (26) eff1_text_7 := "str'95'eff'95'start called twice";
text (28) eff2_text_8 := "str'95'eff'95'start was not called";
text (25) mess_text_9 := "unknown message from task";
text (15) claim_text_10:= "claims exceeded";
text (20) area_text_11 := "area claims exceeded";
text (10) fp_text_12 := "fp trouble";
text (11) write_text_13:= "write error";
text (13) prog_text_14 := "error in task";
text (13) mtr_text := "monitor call ";
text (11) result_text := " - result =";
text (20) stop_text := "createtask stopped'10''10'";
\f
! p r o c e d u r e f a t a l _ e r r o r p a g e 2 !
begin
error_no := w2; mtr_call_no := w1; result := w0;
write(.w3., w0:=address(error_text));
if w2 > 0 then
begin
case w2 := error_no of
begin
write (.w3., w0:=address(fp1_text_1));
write (.w3., w0:=address(fp2_text_2));
write (.w3., w0:=address(core_text_3));
write (.w3., w0:=address(sysdef_text_4));
write (.w3., w0:=address(buff_text_5));
write (.w3., w0:=address(int_text_6));
write (.w3., w0:=address(eff1_text_7));
write (.w3., w0:=address(eff2_text_8));
write (.w3., w0:=address(mess_text_9));
write (.w3., w0:=address(claim_text_10));
write (.w3., w0:=address(area_text_11));
write (.w3., w0:=address(fp_text_12));
write (.w3., w0:=address(write_text_13));
write (.w3., w0:=address(prog_text_14));
end;
write(.w3., w2:=10); ! nl !
end;
if w1 := mtr_call_no > 0 then
begin
layout (0, 32, 2);
write(.w3., w0:=address(mtr_text));
write(.w3., w0:=mtr_call_no);
write(.w3., w0:=address(result_text));
write(.w3., w0:=result);
write(.w3., w2:=10); ! nl !
end;
write (.w3., w0:=address(stop_text));
w2 := 3; fp(7); ! stop execution with ok.no warning.yes !
end;
end;
! p r o c e d u r e f a t a l _ e r r o r e n d !
\f
end.
▶EOF◀