|
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: 6912 (0x1b00)
Types: TextFile
Names: »proctranstx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦80900d603⟧ »giprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦80900d603⟧ »giprocfile«
└─⟦this⟧
; proctrans_tx * page 1 27 09 77, 13.56;
; proc_transla
; ************
if listing.yes
char 10 12 10
proc_transla = set 1
proc_transla = algol
external long procedure proc_transla
____________________________________
_ (proc_name);
string proc_name;
begin
zone pz(128, 1, stderror);
integer array entry(1:10);
array name_a(1:3);
integer field extnls, qbytes, date, time;
integer size, nta, content, ng, ne, nb, segm, t;
boolean field content_f, glb_f, ext_f, next_f;
boolean ext_info, ok;
long array field name_f;
array field rname_f;
move_string_1(name_a, 1, proc_name);
ok := true;
segm := 0;
open(pz, 4, string pump(name_a), 0);
if monitor(42)lookup:(pz, 0, entry) = 0 then
begin
_
comment fixed fields;
_____________________
rname_f :=
name_f := 2;
content_f := 17;
ext_f := 18;
next_f := 504;
\f
comment proctrans_tx * page 2 27 09 77, 13.56
0 1 2 3 4 5 6 7 8 9 ;
comment status after lookup
___________________________
entry_type size doc_name nta cont ext_i
_____________________________________________________
head_proc >0 e.g. disc <0 4 used
head_aux_proc <0 head_proc <0 4 not u
head_own_var <0 head_proc >=0 4 not u
cmpr_proc <0 head_proc <0 >=32 used
cmpr_aux proc <0 cmpr_proc <0 4 not u
cmpr_own_var <0 cmpr_proc <0 4 not u
syst_own_var 0 e.g. disc 0 4 not u
syst_own_var is treated separately. all entries
with size < 0 are looked up again. the position of
the external list is saved for head_proc and
cmpr_proc;
comment check for external proc or var;
_______________________________________
content := entry.content_f extract 12;
if content = 4 or content >= 32 then
begin
size := entry(1);
nta := entry(6);
if size <> 0 then
begin
ext_info := size > 0 or content >= 32;
if ext_info then
begin
ext_f := (entry.ext_f extract 12) + 2;
glb_f := ext_f - 1;
qbytes := ext_f + 2;
end;
if size < 0 then
begin
if content >= 32 then segm := content - 32;
close(pz, true);
open(pz, 4, string pump(entry.rname_f), 0);
\f
comment proctrans_tx * page 3 27 09 77, 13.56
0 1 2 3 4 5 6 7 8 9 ;
if monitor(42)lookup:(pz, 0, entry) = 0 then
begin
_
comment status after lookup
___________________________
entry_type size doc_name nta cont ext_f
__________________________________________________
head_aux_proc >0 e.g. disc <0 4 used
head_own_var >0 e.g. disc <0 4 used
cmpr_proc >0 e.g. disc <0 4 not u
cmpr_aux_proc <0 head_proc <0 >=32 used
cmpr_aux_var <0 head_proc <0 >=32 used
all entries with size < 0 are looked up again to
get information for loading the code from bs-dev.
the position of the external list is taken when
not found before;
size := entry(1);
content := entry.content_f extract 12;
if -, ext_info then
begin
ext_f := (entry.ext_f extract 12) + 2;
glb_f := ext_f - 1;
qbytes := ext_f + 2;
end;
if size < 0 then
begin
if content >= 32 then segm := content - 32;
close(pz, true);
open(pz, 4, string pump(entry.rname_f), 0);
ok := monitor(42)lookup:(pz, 0, entry) = 0;
end last lookup;
end
else ok := false;
end;
\f
comment proctrans_tx * page 4 27 09 77, 13.56
0 1 2 3 4 5 6 7 8 9 ;
comment input of procedure code;
________________________________
if ok then
begin
setposition(pz, 0, segm);
inrec_6(pz, 512);
ng := pz.glb_f extract 12;
ne := pz.ext_f extract 12; ;
if qbytes >= 504 then
begin comment qbytes on next segm;
t := 10 - 512 + (pz.next_f extract 12);
qbytes := qbytes + t;
ext_f := ext_f + t;
inrec_6(pz, 512);
end;
nb := pz.qbytes;
date := ext_f + 2*ng + 12*ne + nb + 4;
for t := 10 - 512 + (pz.next_f extract 12)
_ while date >= 504 do
begin
date := date + t;
inrec_6(pz, 512);
end;
time := date + 2;
date := pz.date;
if time = 504 then
begin
time := 10 - 512 + time + (pz.next_f extract 12);
inrec_6(pz, 512);
end;
time := pz.time;
end input of proc code;
\f
comment proctrans_tx * page 5 27 09 77, 13.56
0 1 2 3 4 5 6 7 8 9 ;
end size <> 0
else if nta = 0 then
<*system_own_variable*>
_______________________
begin
time := 0;
close(pz, true);
open(pz, 4, <:algol:>, 0);
if monitor(42)lookup:(pz, 0, entry) = 0 then
begin
date := ((entry(6) extract 12) - 1900)
_ + (entry(6) shift (-12))*100;
time := 0;
end
else
begin
close(pz, true);
open(pz, 4, <:fortran:>, 0);
date :=
if monitor(42)lookup:(pz, 0, entry) = 0 then
(((entry(6) extract 12) - 1900)
_ + (entry(6) shift (-12))*100)
else (-1);
end;
end system_own_var
else
date := -1;
end else date := -1;
end else date := -1;
if date > 0 and ok then
begin
if date > 311300 then
<*to hell with ISO*>
date := (date mod 100)*1 00 00
_ +((date//100) mod 100)*100
_ + date//1 00 00;
proc_transla := extend 10000*date + (time + 70)//100;
end
else
proc_transla := -1;
close(pz, true);
end proc_transla;
end;
if warning.yes
(mode 0.yes
message proc_transla not ok
lookup proc_transla)
▶EOF◀