|
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: 9216 (0x2400)
Types: TextFile
Names: »getexterntx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦baac87bee⟧ »gi«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦baac87bee⟧ »gi«
└─⟦this⟧
comment predit text * page 1 3 03 80, 15.14
0 1 2 3 4 5 6 7 8 9 ;
comment case 14, getextern
create name leverer et workname til workfile
workfile creater et non_area entry
;
begin
integer i, n, t, firstm, procnumbers, shiftv, scope,cskift;
boolean auto, from, copy, gbtx, not_clear;
real array contra, comp, devi, myst(1:2);
integer array zdes(1:20);
integer array tail(1:10), headm(1:17), alpha(0:255);
long array save(1:128);
zone zbr, zmulti, zm(128, 1, stderror);
integer field word, inf;
real array field name;
long array field zn;
procedure stop(s); string s;
system(9, 0*write(out, <:<10>***:>, s, nl, 1), <:getextern:>);
comment procedure for transfer of procnames;
procedure transproc;
begin
integer i;
repeat
i := read_string(zbr, save, 1);
write(zmulti, save);
until i > 0;
set_position(zbr, 0, 0);
end;
procedure shiftchar(ch);
value ch; integer ch;
begin
contra.inf := contra.inf + ch shift shiftv;
shiftv := shiftv - 8;
if shiftv = -8 then
begin
inf := inf + 2; shiftv := 16;
end;
end;
\f
comment predit text * page 2 3 03 80, 15.14
0 1 2 3 4 5 6 7 8 9 ;
name := 6;
first_m := 3;
zn :=
word := 2;
shiftv := 1;
n :=
procnumbers :=
scope := 0;
devi(1) :=
devi(2) := real <::>;
from :=
gbtx :=
auto := false;
if readparam(comp) <> -1 then
_ stop(<:param error - left hand:>);
for i := readparam(contra) while i <> 0 and n < 3 do
begin
if i = 2 then
begin
n := n + 1;
t := nr_string(t, 4, string(contra(1)), case t of (
_ <:auto:>, <:scope:>, <:from:>, <:gbtx:>)) - 1;
if t = 0 then n := 4;
end
else
\f
<* predit text * page 3 3 03 80, 15.14
0 1 2 3 4 5 6 7 8 9 *>
if i = 4 then
begin
case (if t < 4 then t else 3) of
begin
begin <* auto *>
auto := contra(1) = real <:yes:>;
firstm := firstm + 2;
if auto then stop(<:auto not implemented:>);
end;
begin
if shiftv = 1 then
begin
scope := nr_string(scope, 4, string(contra(1)),
_ case scope of (
_ <:proj:>, <:user:>, <:login:>, <:clear:>)) -1;
if scope = 0 then
_ stop(<:param error illegal scope:>);
firstm := firstm + 2;
end
else
if shiftv = 2 then
begin
devi(1) := contra(1);
devi(2) := contra(2);
firstm := firstm + 1;
end;
shiftv := shiftv + 1;
end;
begin
from := t = 3;
gbtx := t = 4;
myst(1) := contra(1);
myst(2) := contra(2);
end;
end;
end
else
stop(<:param error illegal sequence:>);
end;
not_clear := scope <> 4;
for i := readparam(contra) while i <> 0 do;
for i := 1 step 1 until firstm do readparam(contra);
if -, from and -, gbtx and not_clear then
stop (<:param error not getextern call:>);
if not_clear then
begin
open (zm, 4, string pump (myst), 0);
if monitor (76, zm, 0, headm) > 0 or headm(16) shift (-12) <> 10 then
stop (<:contract file does not exist:>);
inrec6(zm,512);
n := zm(128) extract 24;
cskift := if zm.word shift (-12) = (n+14)//15 then
_ -12 else -6;
setposition(zm, 0, 0);
end;
\f
comment predit text * page 4 3 03 80, 15.14
0 1 2 3 4 5 6 7 8 9 ;
open (zbr, 4, <::>, 0);
tail (1) := 1;
for t := 2 step 1 until 10 do tail(t) := 0;
i := monitor(40)create entry:(zbr, 0, tail);
if i <> 0 then stop(<:temp work store not created:>);
get_zone(zbr, zdes);
comment file for compresstext created;
if scope = 0 then
begin
scope := if fp_mode(1) then 1 else
_ if fp_mode(2) then 2 else
_ if fp_mode(3) then 3 else 0;
end;
open(z_multi, 4, string pump(comp), 0);
tail(1) := 1;
for t := 2 step 1 until 10 do tail(t) := 0;
i := monitor (40) create entry:(zmulti, 0, tail);
if i <> 0 and i <> 3 then
stop(<:resultfile create trouble:>);
if i = 3 then
begin
monitor(48)remove entry:(zmulti, 0, tail);
i := monitor(40)create entry:(zmulti, 0, tail);
if i <> 0 then stop(<:resultfile create trouble:>);
end;
if monitor(50)permanent entry:(zmulti, 2, tail) <>0 then
stop(<:no login resources to resultfile:>);
indateproc(zmulti);
comment entry for multiprogram created;
for i := 0 step 1 until 127 do
_ alpha(i) := 6 shift 12 add i;
alpha(0) :=
alpha(127) := 0;
alpha(25) := 8 shift 12 add 25;
intable(alpha);
for i := readparam(contra) while i <> 0 do
begin
if i <> 2 then stop(<:param error illegal sequence:>);
if from then
begin
i := readparam(comp);
if i <> 4 then stop(<:param error illegal sequence:>);
end
else
\f
<* predit text * page 5 3 03 80, 15.14
0 1 2 3 4 5 6 7 8 9 *>
begin <* gbtx *>
comp(1) := contra(1);
comp(2) := contra(2);
contra(1) :=
contra(2) := real <::>;
in_f := 2;
shift_v := 16;
for t := comp.inf shift (-shiftv) extract 8 while t <> 0 do
_ shiftchar(t);
shiftchar(116); <* t *>
shiftchar(120); <* x *>
end of gbtx;
if not_clear then
begin
copy := false;
setposition(zm, 0, 0);
for t := 1 step 1 until n do
begin
inrec_6(zm, 34);
if zm.name(1) = contra(1) and
_ zm.name(2) = contra(2) then
begin
copy := true;
firstm := if zm.word shift(cskift) = 0 then zm.word else
_ zm.word shift(cskift);
write(zbr, string pump(comp), sp, 1, <:,<10>:>);
procnumbers := procnumbers + 1;
if procnumbers = 1 then
begin
if devi(1) <> real <::> then
_ write(zmulti, nl, 2, string pump(comp),
_ <: = set 1 :>, string pump(devi));
write(zmulti, nl, 2, string pump(zdes.zn),
<: = set bs :>, string pump(headm.name), nl, 1);
end;
write(zmulti, nl, 2, string pump(zdes.zn), <: = changeentry :>,
string pump(zdes.zn), sp, 1, string pump(headm.name),
sp, 1, string pump(zdes.zn), sp, 1,
string pump(zdes.zn), sp, 1, firstm, nl, 1,
<:i :>, string pump(zdes.zn), nl, 1);
t := n;
end ifcop;
comment one procedure transferred with warning;
end nstep;
if -, copy then
begin
write(out, nl, 1, string pump(contra), <: not in textstorage:>);
setfpmode(0, true);
end;
\f
comment predit text * page 6 3 03 80, 15.14
0 1 2 3 4 5 6 7 8 9 ;
end
else
begin
procnumbers := procnumbers + 1;
write(zbr, string pump(comp), sp, 1, <:,:>, nl, 1);
end;
end pnulpar;
write(zbr, nl, 2, em, 1);
setposition(zbr, 0, 0);
if not_clear then
begin
write(zmulti, ff, 1, nl, 2,
_ <: if 0.no :>, nl, 1, <:(:>, nl, 1);
for t := readchar(zbr, i) while i <> 32 do
_ outchar (zmulti , i);
write(zmulti, <: = compresslib <44><10>:>);
transproc;
if scope > 0 then
begin
write(zmulti, ff, 1, nl, 2, <: if 0.no :>, nl, 1, <:(:>, nl, 1,
_ <:scope :>, case scope of (<:project:>, <:user:>, <:login:>),
_ <:,:>, nl, 1);
transproc;
write(zmulti, <:):>, nl, 2);
end;
write (zmulti, <:<10> <12><10> lookup , <10>:>);
transproc;
write(zmulti, <:<10> message :>, procnumbers,
<: procedures translated<10><41>:>);
end
else
begin comment clear;
write(zmulti, nl, 3, <:scope temp,:>, nl, 1);
transproc;
write(zmulti, nl, 3, <:clear temp,:>, nl, 1);
transproc;
write(zmulti, nl, 3, <:if ok.yes :>, nl, 1,
_ <:message :>, procnumbers, <: procedures :>,
_ <:cleared:>);
end;
write(zmulti, nl, 2, <:clear temp :>, string pump(zdes.zn),
<:<10>end<10>finis<10><25>:>);
close(zmulti, true);
close(zm, true);
<*remove entry*>
monitor(48, zbr, 1, zdes);
close(zbr, true);
end case 14, getextern;
▶EOF◀