|
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: 20736 (0x5100)
Types: TextFile
Names: »predittx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0f6e8048b⟧ »preditfile«
└─⟦this⟧
\f
comment predit text * page 19 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment case 8, predit;
begin
comment
Algol6 predit.
**************
Program for editing of algol6 source texts.
Call.
_____
<bs file> = predit <in file> <params>
<params> ::= <empty> ! <params><param>
<param> ::= <integer param> ! <boolean param>
<integer param> ::= <integer param name>.<integer>
<integer param name>::= lines ! prefix ! suffix !
_ tab ! page ! margin !
_ paper ! begins
<boolean param> ::= <boolean param name>.<boolean value>
<boolean param name>::= blanks ! head ! mes !
_ first ! print ! marks !
_ col ! slang
<boolean valeu> ::= yes ! no
Willy Lehmann Weng, 1974.
GI reg no 74004 and 75038.
Updated nov 1976 by WW.
;
\f
comment predit text * page 20 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment global variabels;
_ _________________
integer array C(0:132), HLT(0:70);
integer p, q, a, outchar, lc, lcmax, hltc, CS, cw, cpl,
_ tab, tabzero, waitchar, fchar, f1char, bchar, indemq,
_ page, lines, prefix,
_ suffix, margin, paper, start_tab;
boolean FBNL, SF, unterm, line_in_string,
_ incl_pages, incrtab, decrtab, first_spaces,
_ instring, info, INFO, slip, sumtest,
_ mes, head, blanks, b, testfl,
_ left, first_line, first, verflag,
_ print, after_first, marks, col, kom, slang,
_ com, hak, non_skip, out_skip, out_string,
_ out_hak, out_com;
long pag, ext, beg, endsp, esem, stqb, stqe, test,
_ teststq, testesem, testend, lg, tprver, prvers,
_ com_tx, mes_tx, hak_beg, hak_slt, two_chars,
_ three_chars, six_chars;
real time, date;
integer array tail (1:12), zone_des(1:20),
_ mes_buf(0:7), old_out(1:20);
zone zout(128*2, 2, stderror);
\f
comment predit text * page 21 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
integer procedure parent_message(mes);
______________________________________
integer array mes;
begin
comment send the message in mes to
the parent, ie. the operating-system
executing the program;
integer i,
_ parent_addr,
_ mode_kind;
real array parent_name(1:2);
integer array sh_des(1:12);
zone parent(1, 1, stderror);
parent_addr:= system(8, mode_kind, parent_name);
i := 1;
open(parent, mode_kind, string(parent_name(increase(i))), 0);
get_share(parent, sh_des, 1);
for i:= 4 step 1 until 11 do
sh_des(i):= mes(i-4);
set_share(parent, sh_des, 1);
i:= monitor(16)send_message_to:(parent, 1, sh_des);
if i=0 then system(9, 0, <:<10>bufclaim:>);
if mes_buf(0) extract 5 = 0 then
i:= monitor(18)wait_answer_from:(parent, 1, mes);
parent_message:= i;
end parent_message;
\f
comment predit text * page 22 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
integer procedure LYN;
begin
integer ch;
read_char(in, ch);
if ch = 12 <* FF *> then ch:= 10 <* NL *>;
info:= (info or (ch<>32 and (ch<>10 or instring)));
INFO:= INFO or info;
LYN:= ch
end LYN;
procedure side_feed;
begin integer lsc, lrd, t, i, d; boolean normcode;
lsc:= page:= page+1;
if -, first_line then
write(zout, false add 10,
(if blanks then lines-lc else 0)+suffix,
<:<12>:>);
lc:= 0;
write(zout,
false add 10, prefix,
if tab <= start_tab and col then <:; _____:> else
(if hak then <:<60>*_______:> else
(if mes then <:message :> else <:comment :>)));
if head then
begin
for i:= 0 step 1 until hltc do
write(zout, false add HLT(i), 1);
end;
write(zout, false add 32, 20-hltc,
<:_*_page_:>, <<d>, lsc,
false add 32, 3,
<<dd dd dd>, date, <:, :>, <<dd.dd>, time);
if marks and (tab > start_tab or -, col) then
begin
comment write tabulation mark;
write(zout, <:<10>:>);
lc:= lc+1;
for i:= tabzero step 1 until 9 do
write(zout, <<d>, i, false add 32, indemq-1);
end if marks;
write(zout, if hak then <:*<62><10><10>:> else <:; <10><10>:>);
lc:= lc+3;
fchar:= 0;
if after_first then
begin
if hak then
begin
for a:= LYN while fchar <> 42 or a <> 62 do
fchar:= a;
end if hak
else
begin
for a:= LYN
while a <> 59 do;
end;
end after_first;
SF:= com:= hak:=INFO:=FBNL:=false;
end side_feed;
\f
comment predit text * page 23 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
procedure writetab;
begin integer t;
if testfl then
write(zout, <:Tabs.:>,
if incrtab then <:inc.:> else <:not inc.:>,
if decrtab then <:dec.:> else <:not dec.:>,
<:Old value::>, <<dd>, tab, <:<10>:>);
if incrtab==decrtab then incrtab:=decrtab:=false;
if decrtab then tab:=tab-indemq;
write(zout, false add 32, tab);
if incrtab then tab:=tab+indemq;
end writetab;
\f
comment predit text * page 24 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment initializing of parameters;
_ ___________________________
systime(1, 0, time);
date:= systime(2, time, time);
time:= time/10000;
tab := 0;
page:= 0;
marks := true;
tabzero:= 0;
blanks := false;
print := false;
left := false;
head := true;
mes := false;
testfl := false;
first := true;
col := false;
slang := false;
hak := false;
com := false;
nonskip:= false;
FBNL:=incrtab:=decrtab:=instring:= false;
after_first := false;
line_in_string:= false;
first_line := true;
indemq := 2;
paper := 0;
lines := 70;
prefix := 2;
suffix := 0;
ext := long <:terna:> add 108;
pag := long <:_page:> add 32;
tprver := long <:prver:> add 115;
beg := long <:begin:> add 32;
endsp := long <:_end_:> shift (-8);
esem := long <:_end<59>:> shift (-8);
stqb := long <:<60>::> shift (-32);
stqe := long <::<62>:> shift (-32);
comtx := long <:mment:> add 32;
mes_tx := long <:ssage:> add 32;
hak_beg:= long <:<60>*:> shift (-32);
hak_slt:= long <:*<62>:> shift (-32);
lcmax := 69;
lc := 2;
\f
comment predit text * page 25 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
begin
comment reading of fp-param;
_ ____________________
integer param_no, i, s, sepa,
_ length, s_save, name_no;
real array name, param(1:2);
procedure alarm(text);
string text;
begin
comment write the alarm-text on current
output;
i:= 1;
sepa:= s shift (-12);
length:= s extract 12;
write(out, <:<10>***:>,
string(name(increase(i))),
<: :>, text);
if s<> 0 then
begin
write(out,
<: (:>, <<d>, param_no,
<:, :>, case ((sepa+6)//2) of (
<:'end of command list':>,
<:'end parenthesis':>,
<:'begin parenthesis':>,
<:'NL':>,
<:<60>s<62>:>,
<:=:>,
<:.:>));
i:= 1;
if length = 10 then
write(out, string(param(increase(i))))
else if length = 4 then
write(out, <<d>, param(1));
write(out, <:):>);
end if s <> 0;
comment skip bad param;
for param_no:= param_no+1 while
(system(4, param_no, param) shift (-12) extract 12) = 8 do;
end alarm;
\f
comment predit text * page 26 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
system(2, i)program_name:(name);
param(1):= param(2):= real <::>;
s_save:= s:= system(4)read_fp_param:(1, param);
if s shift (-12) = 6 then
begin
comment left side in call;
left:= true;
param_no:= 3;
s_save:= system(4, 2, param);
i:= 1;
s_save:= system(4, 2, param);
system(4, 0, param);
open(zout, 4, string(param(increase(i))), 0);
s:= monitor(42)lookup_entry:(zout, i, tail);
tail(1):= 36;
for i:= 2 step 1 until 12 do tail(i):= 0;
if s<> 0 then
s:= monitor(40)create_entry:(zout, i, tail);
if s<> 0 then
system(9)run_time_alarm:(s, <:<10>create :>);
in_date_proc(zout);
end if s shift (-12) = 6
else
begin
comment no output;
left:= false;
s:= 0;
alarm(<:no output:>);
system(9)run_time_alarm:(0, <:<10>sorry :>);
end if no left side;
s:= system(4, param_no, param);
sepa:= s shift (-12);
if s_save = 0 or (s<>0 and sepa<>4) then
begin
comment no input file;
alarm(<:no input:>);
system(9, param_no, <:<10>sorry :>);
end if s_save or;
\f
comment predit text * page 27 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
for length:= s extract 12 while sepa >= 4 do
begin
comment read the next pair
of fp-param;
if sepa = 8 then alarm(<:point:>)
else if sepa <> 4 then
system(9, param_no, <:<10>fperror1:>)
else if length = 4 then alarm(<:integer:>)
else if length <> 10 then
system(9, param_no, <:<10>fperror2:>)
else
begin
comment name param with
preceding space read;
name_no:= 0;
if param(2) = real <::> then
for i:= 1 step 1 until 17 do
if param(1) = real(case i of (
<:blank:> add 115, <:head:>,
<:mes:>, <:test:>, <:first:>,
<:print:>, <:marks:>, <:col:>,
<:slang:>,
<:lines:>, <:prefi:> add 120,
<:suffi:> add 120, <:tab:>, <:page:>,
<:margi:> add 110, <:paper:>,
<:begin:> add 115)) then
begin
name_no:= i;
i:= 17
end if param(1) = real(case;
\f
comment predit text * page 28 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
if name_no > 0 then
begin
comment name recognized;
param_no:= param_no + 1;
s := system(4, param_no, param);
sepa := s shift (-12);
length := s extract 12;
if sepa <> 8 or
(if name_no <= 9 then
(length <> 10 or
(param(1) <> real <:yes:> and param(1) <> real <:no:>))
else length <> 4 ) then
alarm(<:value:>) else
begin
comment value type ok;
i:= param(1);
b:= param(1) = real <:yes:>;
case name_no of
begin
blanks:= b;
head := b;
mes := b;
testfl:= b;
first := b;
print := b;
marks := b;
col := b;
slang := col := b;
lines := i;
prefix:= i;
suffix:= i;
indemq:= i;
page := i-1;
margin:= i;
paper := i;
tab := i;
end case name_no of;
param_no:= param_no + 1;
end if value type ok
end if name_no > 0 else alarm(<:param:>);
end name param read;
s:= system(4, param_no, param);
sepa:= s shift (-12);
end for length:= s extract 12 ;
end reading of fp-param;
\f
comment predit text * page 29 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
prvers:= 11 02 80 16 42;
if testfl then
write(out, <:<10>Algol6 predit, version:>,
<< dd dd dd>, prvers/10000, <:, :>,
<< dd.dd>, (prvers mod 10000)/100);
comment reading of head text;
_ _____________________
if head then
begin
for p:=LYN while p=10 or p=12 or p=32 do;
for hltc:= 0, hltc+1 while p<>10 do
begin
if p=42 <* * *> then
begin
for p:= LYN while p <> 59 <* ; *> do;
p:= 10 <* NL *>;
hltc:= hltc - 1;
end else
begin
HLT(hltc):=p;
p:= LYN
end
end for hltc;
for q:= 0, 1, 2 do
begin
boolean found;
found:= true;
for p:= 0 step 1 until 7 do
found:= (HLT(p) = (case (q*8 + p+1) of
(99, 111, 109, 109, 101, 110, 116, 32,
109, 101, 115, 115, 97, 103, 101, 32,
59, 32, 32, 32, 32, 32, 32, 32)))
and found;
if found then
hltc:= hltc-8;
if found then
for p:= 0 step 1 until hltc do
HLT(p):= HLT(p+8);
end for q:= 0, 1;
if HLT(0) = 59 then
begin
comment fjern foran stående semikolon og space;
for q:= 0, q+1 while HLT(q)=32 do;
for p:= q step 1 until hltc do
HLT(p-q):= HLT(p);
hltc:= hltc-q-1;
end if HLT(0);
if hltc>20 then hltc:= 20
else hltc:= hltc-1;
if testfl then
begin
comment test output on current output;
write(out, <:<10>head :>);
for p:= 0 step 1 until hltc do
write(out, << ddd>, HLT(p));
end if testfl;
end else hltc:= 0;
\f
comment predit text * page 30 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment init of control variables for
non-editing of komma and semikolon in
strings and comments;
out_skip:= false;
out_hak := false;
out_com := false;
two_chars:= three_chars:= six_chars:= long_zero;
comment set tabulation for first 'begin';
tab:= -tab*indemq;
start_tab:= tab;
if first then side_feed;
after_first:= true;
\f
comment predit text * page 31 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment read and output line;
_ _____________________
for q:=-1, -1 while unterm do
begin
test:= 32;
verflag:= false;
a:=p:=-1; cpl:=1; INFO:=info:=SF:=false; fchar:=32;
for q:=q+1 while a<>10 do
begin
a:= LYN;
if a=12 then a:= 10;
bchar:= if a=10 then 32 else a;
C(q):= a;
unterm:= a<>25;
p:=p+1; f1char:=fchar;
fchar := test shift(-40) extract 8;
test := test shift 8 add bchar;
teststq:= test shift 32 shift (-32);
comment replace colon and semicolon before 'end' by space;
cw := test shift (-32) extract 8;
cw := if cw = 58 or cw = 59 then 32 else cw;
testend:= (extend cw shift 32) +
(test shift 16 shift (-16));
non_skip:= -, (com or hak or in_string);
\f
comment predit text * page 32 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
if test= pag and (fchar=42 or f1char=42 and fchar=32) then
begin
SF:=true; INFO:=info:=FBNL:=false; a:=10;
end
else
if ( (test= beg and (fchar=32 or fchar=10))
_ or (test= ext and fchar=120 and f1char=101))
and non_skip
then incrtab:= true
else
if tab > start_tab then
begin
comment in algol text;
if verflag then
begin
if a=58 then
begin
comment skip rest of line for new program version date;
for p:= p while a<>10 do
begin
a:= LYN;
unterm:= a<>25;
if -, unterm or a=12 then a:= 10;
end for p;
end else
verflag:= a=32
end if verflag
else
if nonskip then
begin
if (test= tprver and (fchar=32 or
_ fchar=58 or
_ fchar=59 or
_ fchar=61)) then
verflag:= true
else
if testend=endsp
or testend= esem then decrtab:=true
else if teststq = stqb then instring:= true;
hak := hak or (teststq = hak_beg);
com := com or ( test = comtx and
_ f1char = 99 and
_ fchar = 111)
_ or ( test = mestx and
_ f1char = 109 and
_ fchar = 101);
end non_skip
else
begin
hak := hak and teststq <> hak_slt;
com := com and a <> 59;
instring:= instring and test_stq <> stqe;
end skip;
end if tab > start_tab;
\f
comment predit text * page 33 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
if testfl then
begin
for lg:= test, testend, teststq do
begin
write(zout, <:<10>:>);
for cw:= -40 step 8 until 0 do
write(zout, << ddd>, (lg shift cw) extract 8);
end for lg;
write(zout, <:<10>:>);
end if test;
if -, unterm then a:=10;
end read_line_loop;
\f
comment predit text * page 34 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
q:=0;
if INFO then
begin
FBNL:= first_spaces:= true; lc:= lc+1;
kom:= false;
if -, line_in_string and -, slang then writetab;
line_in_string:=instring;
incrtab:=decrtab:=false;
for p:=p step -1 until 0 do
begin
outchar:=C(q);
first_line := first_line and
(outchar = 32 or outchar = 10);
first_spaces:= first_spaces and outchar = 32;
if -, first_spaces or slang then
write(zout, false add outchar, 1);
first_spaces:= -, kom and first_spaces;
three_chars:= (three_chars shift 8 add
_ (six_chars shift (-40) extract 8)) extract 24;
six_chars := six_chars shift 8 add out_char;
two_chars := six_chars extract 16;
if out_skip then
begin
out_string:= outstring and two_chars <> stqe;
out_hak := out_hak and two_chars <> hak_slt;
out_com := out_com and out_char <> 59 <* ; *>;
end
else
begin
out_string:= two_chars = stqb;
out_hak := two_chars = hak_beg;
out_com := three_chars = (long <: co:> shift (-24))
and six_chars = com_tx;
end non out_skip;
out_skip:= out_string or out_hak or out_com;
<*
for lg:= two_chars, three_chars, six_chars do
begin
write(zout, nl, 1);
for cw:= -40 step 8 until 0 do
write(zout, << ddd>, lg shift cw extract 8);
end for lg;
*>
if (outchar=44 <*,*> or outchar=59 <*;*>)
and -, in_string and -, slang and -, out_skip then
begin
write(zout, false add 32, if outchar=59 then 2 else 1);
firstspaces:= true;
end;
kom:= outchar=44;
q:=q+1;
end p-loop;
\f
comment predit text * page 35 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
if verflag then
begin
comment new version date;
write(zout, <:=:>, << dd dd dd>, date,
<< zd dd>, time*100, <:; <10>:>);
end if verflag;
end
else
if FBNL then
begin
write(zout, false add 10, 1);
lc:=lc+1; FBNL:=false;
end write1_blank_line
else
if SF then
begin
if first_line then
begin
for p:= read_char(in, q) while q<>59 do;
end
else side_feed
end if SF;
end read_and_output_loop;
\f
comment predit text * page 36 11 02 80, 16.42
0 1 2 3 4 5 6 7 8 9 ;
comment close and print;
_ ________________
write(zout, <:<25>:>);
close(zout, true);
if print and left then
begin
comment convert the output file
to lineprinter ;
mes_buf(0):= 30 shift 12 add (1 shift 9);
mes_buf(1):= real <:conv:> shift (-24) extract 24;
mes_buf(2):= real <:conv:> extract 24;
mes_buf(3):= paper;
get_zone(zout, zone_des);
for p:= 4 step 1 until 7 do
mes_buf(p):= zone_des(p-2);
p:= parent_message(mes_buf);
if p <> 1 then system(9)run_time_alarm:(p, <:<10>print :>);
if mes_buf(0) <> 0 then
write(out, <:<10>convert error : :>,
case (mes_buf(0)) of (
<:cbufs exceeded:>,
<:file not visible:>,
<:file has login scope:>,
<:temporary resources insufficient:>,
<:file in use:>)) else
write(out, <:<10>convert ok.:>);
end if print and left;
end case 8, predit;
▶EOF◀