; editfil for bobsnew over i tbobs


; f|lgende er {ndret i forhold til den oprindelige tekst:
; - bobs lever af allokeringsr{kkef|lgen af pointerobjekter, dvs.
;   generel dispose kan ikke bruges!
; - inputgrammatikkens produktions-r{kkef|lge bevares
; - option 99 er tilf|jet til styring af listning af input
; - kald af procedure dump1 er flyttet til de relevante steder
; - beregning af const13 = cost2 div (setmax+1) og ikke som i manualen
;   hvor 59 indg}r uden forklaring og med manglende parentes
; - fjernet variable der ikke bruges ( dummyyp, tegn1, konstp )
; - {ndret indl{sningsproceduren s} et tegn f|rst skrives ved l{sning
;   af det efterf|lgende, dette giver p{nere output hvis man ikke
;   selv angiver metasymboler.
; - consterror skriver ogs} den aktuelle v{rdi af konstanten ud
; - strammet formaterne for outgrammar og testudskrifter op
; - hvis "iterer" skal have mening m} "matrix" v{re VAR-parameter
; - test p} const6 i procedure remember
; - {ndret test p} const6 til const14 i procedure findreduce
; - f|rste tal p} filen tables angiver antal efterf|lgende konstanter 
;   der kan/skal skippes af parsin/out
; - errortable forsynes med en liste af produktionsnumre for hvert fejlnr,
;   produktionsnumrene siger "lidt" om hvorfra de p}g{ldende fejl kan v{re
;   opdaget, dvs en hj{lp n}r man skal finde p} tekster til fejlene.
; - alfalength er sat op til 18 for at tillade terminaler af l{ngde 18
; - specialversion der skelner mellem sm} og store bogstaver, dette opn}s
;   ved at vende betingelsen s} andet edit kald udf|res
; - sat const10 op fra 700 til 800

(
tbobs=edit bobsnew
tbobs=edit tbobs
end
)

;i/
;(*$t- *)
;/,

l./program bobs/,r/*//,r/*//,
  r/parsin/parsin = 'bobsparsin'/,
  r/parsout/parsout = 'bobsparsout'/,
  r/tables/tables = 'bobstables'/,

l./const1=100/,d./const19=30/,d,i/
listoption = 99;    (* option(99) = list.yes or no *)
const1  =  350;     (* maximum number of productions *)
const2  =  286;     (* maximum number of terminal and nonterminal symbols *)
const3  =   50;     (* maximum size of array fcq *)
const4  = 6500;     (* maximum size of array rhs *)
const5  =   63;     (* maximum number of elements in a basis set of an lr(0) table *)
const6  = 6000;     (* maximum value of 'frekvens' *)
const7  = 1500;     (* maximum size of final parse tables *)
const8  =  100;     (* maximum number of lookahead elements of a nonterminal *)
const9  =  800;     (* maximum size of array stack in procedure lr0 *)
const10 =  800;     (* maximum number of parse tables *)
const11 =  130;     (* maximum number of nonterminals *)
const12 =  300;     (* maximum number of terminals *)
const13 =    1;     (* = const2 div (setmax + 1) *)
const14 =   15;     (* maximum size of a parse table *)
const16 = 1200;     (* maximum size of array ll in procedure lalrlookahead
  notice: const16 > const2 *)
const18 =   99;     (* maximum number of options *)
const19 = 4500;     (* max size of array labelbuf - sum of length
     of all production labels  ( options[34])  *)
/,

l./setmax=71/,r/71/143/,
 r/(*72-1*)//,

l./alfalength=10/, r/10/18/,
; !!!!!!!!!!!! {ndring af alfalength kr{ver ogs} {ndring af alf3 !!!!!!
l./alf3=/, r/31/55/,

l./blank=' '/, l1, i/
version = 'bobs8000   version 1988.02.16';
/

l./ rtype=record r: array/, i/
alfa = packed array [1..alfalength] of char;
/,

l./entrytyp=packed/,l1, r/ dummyyp,//,
l./tegn1:/,d,


l./konfigt=packed record/,
l./const2;/, r/;/; xprodnr, /,


l./help:array[0..const2/,
i/
firstleftside, lastleftside : 0..const2; (* used to link 'help' in input sequence *)
/,
l./prodindex:/, r/;/; (* also used as 0..const2 during init *)/,


l./tilstand:array/, r/packed//,

l./options:/, l1, i/
listing : boolean;   (* listing = options(listoption), default=no *)
oldch : integer;     (* 0 after readln, else ord(ch) *)
/,




l./procedure msg(m/, 
l./message(/, r/mes/(* mes/, r/);/); *)/,

l./procedure consterror(s1,s2/,
l./lf,lf,'=/,d, i/
write(lf,lf,' error in ', s1, s2, 'too small (= ',cc:1, ')' );
/,

l./procedure inputerror(nr/,
l./1: write(/,d, i/
1: write('  *** end of file encountered. ');
/,
 
l./procedure fresh;/,
l./while ((ch<>metasymbol[4]) andtestch(c[i],ch)) do/,
r/andtestch(/and testch(/,
l./if false then 11:/, r/false/i<>i/,

l./procedure terminal;/,
l./if false then 77:/, r/if/while/, r/then/do/,

; side 13-14
l./procedure goalsymb;/,
l./begin/, i/
const
length_of_goalsymbol = 10;
/,
l./toalfalength/, r/alfalength/length_of_goalsymbol/,
l./pack(/, i/
for i := length_of_goalsymbol + 1 to alfalength do buffer [ i ] := ' ';
/,


l./procedure inch;/,
l./if eoln(input)/, i/
if listing then
if oldch = 0 then write(lf,' ')
else write(chr(oldch));
/,
l./begin writeln/, d, i/
begin
/, l./readln/, l1, i/
oldch := 0;
/,

l./read(ch)/, r/write(ch);/oldch := ord(ch);
  if ch in ['a'..'z'] then ch := chr(ord(ch)-ord('a') + ord('A'));
/,

; side 16
l./procedure laes(vara/, r/var//,
l./ifi<12/, r/</<=/, g/12/alfalength/,

; side 17
l./procedure nextword;/,
l./<=30/, g3/30/alf3-1/,
l./pack(buffer,11/, r/11/alfalength+1/,
l./pack(buffer,21/, r/21/2*alfalength+1/,


; side 20
l./procedure init;/,
l./combegin:=0/, i/
listing := true; oldch := 0;
/,

l./end;/, i/

antalprod := -1;

for i:=0 to const2 do
with help[i] do
begin
afledt := true;
overgang := true;
prodindex := const1;
rightp := rhsnil;   (* important!? *)
status := finish;
term := true;
end;

firstleftside := 0;
lastleftside := 0;

/,




l./begin init;/,
l./write(lf,lf,''/,r/''/' '/,
l./(*SLUT PAA INDLAES/, i/
listing := options[listoption];
/,

l./metavar:='METASYMBOL'/, r/OL'/OLS'/,

l./write('M1==/, d, i/
for i := 1 to 4 do
write(' m', i:1, '=', metasymbol[i]);
write(lf,lf,' ');
/,

l./point:=top;/,
i/
for point := 0 to const4 do
with rhs[point] do
begin
symbol := const2;
parserp:= nil;
link   := const4;
basisl := const5;
basis  := true;
first  := const19;
length := 100;
end;
/,

l./help[count].rightp =rhsnil then/, d, i/
if help[count].rightp = rhsnil then
begin
help[count].rightp := point;
(* chain the left sides in input order using 'prodindex' *)
if firstleftside = 0 then
firstleftside := count
else
help[lastleftside].prodindex := count;
lastleftside := count;
help[lastleftside].prodindex := 0;
end;
/,


l./procedure dump2;/,
l./write(' SY/,d,i/
write(' ' : 8, 'symbol' : 8, 'link' : 8, 'basisl' : 8, 'parserp' : 8);
/,


l./procedure initprod/,
l./for i:=nont/, d1, i/
i := nontstart;
repeat  (* changed at rc 79.11.12 *)
/,
l./end;end;/, d, i/
if i = nontstart then i := firstleftside
else i := help[i].prodindex;
until i = 0;
/,


l./procedure outgrammar;/,
l./k,j,i,/, r/i/i, oldi/,
l./prodno:=0/, d./while p<>rhsnil/, i/
writeln; writeln;

oldi := 0; (* used to indicate new leftside *)

for prodno := 1 to antalprod do
with prod[prodno] do
begin

i := leftside;
p := start;

if i <> oldi then writeln; (* new leftside *)
writeln; write(prodno:5, '   ');

if i <> oldi then
begin
t := 0; nontwrit(i,t);
write(' ::= '); t := t + 3; 
oldi := i;
end
else
write(' ' : t, '! ');
/,

l./begin p1:=p/, r/begin//,

l./for l:=1 to t+7/, d1, i/
write(' ' : t + 5 (* prodno *) + 3 (* leading spaces *) + 2 (* indention *) );
tt := t;
/,
l./write(' :/, r/ :/:/,


l./p:=rhs[p].link;/, d./end;end;/,



l./procedure erasure/,
l./lambda,/, r/,rest//,



l./procedure matrixout(s:bitmatrix);/,
l./if ((j mod 59/, g/59/(setmax+1)/,

l./procedure writeheadsandtails;/,
l./label 10,20;/, l1, i/
const textlength = 7; (* number of printed chars from internrep *)
/,
l./for i:=1 to 45/, l1, d, i/
write('symbol' : 9, '!' : (35-9), 'heads' : 9, '!' : (4*(1+textlength)+2 - 9),
'tails':9);
/,
l-5, l./for i:=1 to 45 do/,
  g15/to 45/to 4*(1+textlength) + 1/,
 g-16/'I'/'!'/,
l./for tael:=tael+1 to 34/, r/'I'/'!'/,
l./mod 59/, g/59/(setmax+1)/,
l./if nomoreheads/, r/' ',' '/' ', ' ' : textlength/,
l1, r/])/] : textlength)/,
l./,'I');/, r/'I'/'!'/,
l./mod 59/, g/59/(setmax+1)/,
l./if nomoretails/, r/' ',' '/' ', ' ' : textlength/,
l1, r/])/] : textlength)/,


l./procedure iterer(matrix:bitmatrix/,
  r/matrix:/var matrix:/,


l./procedure idogfjern( b:boolean/,
l./function identprod (var/,
l./write(' DU/,
l1, d./dump5;/,
l./boo3:=boo3 orboo4;/,r/orbo/or bo/,
l./if (band (fjboo=false)) then/, r/band/b and/,
l./write('DU/, l1, d./dump5;/,


l./procedure allocp(var p/,
l./if p=nil then/,d,


l./procedure lr0;/,
l./kopi:boolean/, i/
errorprodno : 0 .. const1;
/,

l./procedure niceparser/,
l./konstp/, r/konstp,//,



l./procedure stackellerej;/,
l./begingoalprod:=0/,
l./prodnr:=goalprod;/, l1, i/
xprodnr := prodnr;
/,
l./prodnr:= lqbep^.prodnr;/, l1, i/
xprodnr := prodnr;
/,
l./(****** TILHQRENDE CLOSURE/,
l./closp:=classtop;/, l1, i/
errorprodno := closp^.prodnr;
/,
l./prodnr:=prodno/, l1, i/
xprodnr := errorprodno;
/,



l./procedure remember(p:pointer);/,
l./if false then/ ,r/false/i<>i/,
l./5:fcq/, d, i/
5: with fcq[i] do
begin
if frekvens = const6 then
consterror('remember','const6  ',const6);
frekvens := frekvens + 1;
end
/,



l./procedure lookb;/,
l./if options[17] then/,
r/*)/*) (* nb: newstart is undefined *)/,


l./procedure lookahead;/,
l./hoejres/, r/,hoejres//,


l./procedure adeqwrite ( x/,
l./3:/,
l./for j:=1 to termant do/,
l./write(''/, r/''/' '/,


l./function findreduce(pnr/,
l./(*START AF SUBRUTINE ADEQUAD *)/,
l./const6/, r/6 /14/, r/6/14/,



l./procedure copy(var ch:/,
l./begin ch:=parsin^;/, d, i/
begin
if eoln(parsin) then ch := ' ' else ch := parsin^;
/,


l./procedure emitconstants/,
l./writeln(tables,nontslut)/, i/
writeln(tables, 11); (* number of constants *)
/,


l./procedure compress;/,
l./begin(*COMPRESS*)/,
l./end;(*COMPRESS*)/, i/
if options[17] then dump1; (* tilstand *)
/,




l./procedure errortable;/,
l./lqbep:=newstart; write(lf,lf,no,' : ');/, r/':'/' :',blank/,
;l./if ((i5 mod 5/, r/blank/blank,blank/,
l./for j:= i+1/, i/
writeln(lf,' nr=', oldstart^.xprodnr :1);
/,
l./if i5=ctmax/,
l./end;/, i/
writeln(' nr=', oldstart^.xprodnr :1);
/,



l./ARCH 1977/, d1, i/
write(lf, version, lf);
/,

f




; editeringer til specialversion der skelner mellem sm} og store bogstaver
; og bruger STRINGV istedet for STRING
; 86 09 24
l./(*INITIALISERING*)/,
l./'STRING/, r/G /GV/,

l./unused;/,
; page 15-16
l./procedure inch;/,
l./ifchin/, d,

; page 20
l./procedure init;varc:char/,
l./'A/, l1, i/
for c:= 'a' to 'z' do chgroup[ c ]:= alfanum;
/,


f