DataMuseum.dk

top - metrics - download

    Length: 9216 (0x2400)
    Types: TextFile
    Names: »crosspas«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »crosspas« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »crosspas« 

TextFile

(*$c+ *)
(*$t- *)
program pascal_cross(infil,output);

label 10;

const hashsize=1373;
maxline=47;

type states=(neutral, ident, to_com, com, from_com, string1, string2, number);
symbols=(letter, digit, left_bracket, star, right_bracket,
mark, double_mark, blank, underlin, other);
whats=(keyword, identifier);
hashindex=0..hashsize;
occ_list = packed  record
where : 1..100000;
decl : boolean;
next : ^occ_list
end;
hashrec = packed  record
id : alfa;
following : hashindex;
case what : whats of
identifier : (first, last : ^occ_list);
keyword : (key_occ : integer);
end;
hashc  =record
case con:integer of
1 : (int : integer);
2 : (al  : alfa)
end;

var state : states;
symbolgroup : symbols;
symbol : char;
table_full_at_line,
blockcount,       (* begin-counter *)
othercount,       (* record and case-statement counter *)
localline,        (* procedure-local line numbers *)
linenumber : integer;
curdate,
curtime,
filename,        (* input file name used as heading on output *)
newid : alfa;
occurrence : ^occ_list;
hashconv : hashc;
top : hashindex;
keywordtop : hashindex;
next_state : arrayÆstates,symbolsÅ of states;
hash_table : arrayÆhashindexÅ of hashrec;
outputfile,
endline : boolean;
infil : text;
idlength : 0..12;

value
state=neutral;
blockcount = 0;
othercount = 0;
localline=-1;
linenumber=0;
newid='  ';
top = hashsize;
outputfile = false;
endline = true;
next_state = ((ident,   number,  to_com,   neutral, neutral, string1, string2, neutral, neutral, neutral),
(ident,   ident,   to_com,   neutral, neutral, string1, string2, neutral, ident,   neutral),
(ident,   number,  to_com,   com,     neutral, string1, string2, neutral, neutral, neutral),
(com,     com,     com,      from_com,com,     com,     com,     com,     com,     com),
(com,     com,     com,      from_com,neutral, com,     com,     com,     com,     com),
(string1, string1, string1,  string1, string1, neutral, string1, string1, string1, string1),
(string2, string2, string2,  string2, string2, string2, neutral, string2, string2, string2),
(number,  number,  to_com,   neutral, neutral, string1, string2, neutral, neutral, neutral));

procedure insert_id(var nid : alfa; ide : whats); forward;

procedure init;
const
power12 = 4096;
equality = 6;
noof_keywords = 38;
var
i,j : integer;
id : alfa;
keywords : arrayÆ1..noof_keywordsÅ of alfa;
value
keywords=('WITH',
'WHILE',
'VAR',
'VALUE',
'UNTIL',
'TYPE',
'TO',
'THEN',
'SET',
'REPEAT',
'RECORD',
'PROGRAM',
'PROCEDURE',
'PACKED',
'OTHERWISE',
'OR',
'OF',
'NOT',
'NIL',
'MOD',
'LABEL',
'IN',
'IF',
'GOTO',
'FUNCTION',
'FORWARD',
'FOR',
'FILE',
'END',
'ELSE',
'DOWNTO',
'DO',
'DIV',
'CONST',
'CASE',
'BEGIN',
'ARRAY',
'AND');
begin
date(curdate); time(curtime);
table_full_at_line := -1;
for i:=0 to hashsize do hash_tableÆiÅ.id:='          ';
for i:=1 to noof_keywords do
begin
insert_id(keywordsÆiÅ,keyword);
end;
keywordtop:=top;
top:=hashsize;

i:=system(1,j,id);
if i div power12 = equality then
begin (* get outputfile *)
i:=system(0,j,id);
if i mod power12 = 10 then
begin
outputfile:=true;
open(output,id);
rewrite(output);
end
else
begin
writeln(' ??? illegal output-filename');
goto 10;
end;
i:=2;
end
else i:=1;

(* get input file *)
i:=system(i,j,id);
if i mod power12 = 10 then
begin
open(infil,id);
reset(infil);
filename := id;
end
else
begin
if outputfile then close(output);
writeln(' ??? illegal input-filename');
goto 10;
end;
end;


procedure newpage;
begin
page(output);
write(output, filename, curdate, curtime);
write(output,'page':50,((linenumber div maxline)+1):6);
writeln(output);
writeln(output);
end;


procedure nextsymbol(var s:char; var sgroup:symbols);
begin
if endline then
begin
if (linenumber mod maxline)=0 then newpage;
linenumber:=linenumber+1;
write(output,linenumber:6);
if localline >= 0 then
begin
localline := localline + 1;
write(output, localline : 4, ' ');
end
else write(output,' ':5);
end;
if eoln(infil) or (infil^ = ff) then
begin
endline:=true;
writeln(output);
if (infil^ = ff) and ((linenumber mod maxline) <> 0) then newpage;
end
else endline:=false;
(* LINENUMBER IS INCREMENTED JUST BEFORE READING THE
FIRST CHARACTER ON THE NEW LINE *)
s:=infil^;
get(infil);
if not endline then write(output,s);
if s > '_' then s:=chr(ord(s)-32);
case s of
'A','B','C','D','E','F','G','H','I','J',
'K','L','M','N','O','P','Q','R','S','T',
'U','V','W','X','Y','Z','_' : sgroup:=letter;
'0','1','2','3','4','5','6','7','8','9' : sgroup:=digit;
'('      : sgroup:=left_bracket;
'*'      : sgroup:=star;
')'      : sgroup:=right_bracket;
''''     : sgroup:=mark;
'"'      : sgroup:=double_mark;
' '      : sgroup:=blank;
end
otherwise    sgroup:=other;
end;

procedure insert_id  (* (VAR NID:ALFA; IDE:WHATS) *) ;
var found:boolean;
h:hashindex;
d:integer;
begin
if nid<>'          ' then
begin
hashconv.al:=nid;
h:=abs(hashconv.int) mod hashsize;
(*THE 3 MOST SIGNIFICANT CHARACTERS ARE USED AS AN INTEGER*)
found:=false;
d:=1;
repeat
if hash_tableÆhÅ.id=nid then
begin  (*ALL OK*)
found:=true;
case hash_tableÆhÅ.what of
identifier : begin
new(occurrence);
hash_tableÆhÅ.last^.next:=occurrence;
occurrence^.where:=linenumber;
occurrence^.decl := blockcount = 0;
hash_tableÆhÅ.last:=occurrence;
end;
keyword    : begin
hash_tableÆhÅ.key_occ:=hash_tableÆhÅ.key_occ+1;
if nid = 'BEGIN       ' then
begin
blockcount := blockcount + 1;
if localline = -1 then localline := 0; (* start of block *)
end
else
if nid = 'END         ' then
begin
if othercount > 0 then (*record or case match *)
othercount := othercount - 1
else
if blockcount > 0 then
begin (* begin-match *)
blockcount := blockcount - 1;
if blockcount = 0 then (* end block *)
localline := -1;
end
else writeln(output,'??? error in blockstructure, detected at line:',
linenumber:6);
end
else
if nid = 'RECORD      ' then othercount := othercount + 1
else
if nid ='CASE        ' then if blockcount > 0 then (* case-statement *)
othercount := othercount + 1;
end;
end;
end
else
if hash_tableÆhÅ.id='          ' then
begin  (*MAKE NEW ENTRY*)
found:=true;
hash_tableÆhÅ.id:=nid;
hash_tableÆhÅ.what:=ide;
case ide of
identifier : begin
new(occurrence);
hash_tableÆhÅ.first:=occurrence;
hash_tableÆhÅ.last:=occurrence;
occurrence^.where:=linenumber;
occurrence^.decl := blockcount = 0;
end;
keyword    : begin
hash_tableÆhÅ.key_occ:=0;
end
end;
hash_tableÆhÅ.following:=top;
top:=h;
end
else
begin  (*COLLISION*)
h:=(h+d) mod hashsize; d:=d+2;
if d=hashsize then
begin  (*TABLE QUASI-FULL*)
if table_full_at_line = -1 then table_full_at_line := linenumber;
found:=true; (*WE DO NOT INSERT THE NID*)
end;
end
until found;
end;
nid:='          ';
idlength:=0;
end; (*INSERT_ID*)


procedure add_to_id(var newid:alfa; symbol:char);
begin
if idlength<12 then
begin
idlength:=idlength+1;
newidÆidlengthÅ:=symbol;
end;
end;


procedure sort_table;
var i,j,least:integer;
beforei,beforej,beforeleast:-1..hashsize;
nextid:alfa;
begin
i:=top;
beforei:=-1;
while i<hashsize do
begin
nextid:=hash_tableÆiÅ.id;
least:=i;
beforeleast:=-1; beforej:=i;
j:=hash_tableÆiÅ.following;
while j<hashsize do
begin
if hash_tableÆjÅ.id<nextid then
begin
least:=j;
nextid:=hash_tableÆjÅ.id;
beforeleast:=beforej;
end;
beforej:=j;
j:=hash_tableÆjÅ.following;
end;
(*CHANGE POINTERS*)
if beforeleast>-1 then
begin
hash_tableÆbeforeleastÅ.following
:=hash_tableÆleastÅ.following;
hash_tableÆleastÅ.following:=i;
if beforei>-1 then
hash_tableÆbeforeiÅ.following:=least
else top:=least;
(*WE KEEP THE I*)
beforei:=least;
end
else
begin  (*HASH_TABLEÆIÅ WAS THE LEAST*)
if beforei=-1 then top:=i;
beforei:=i;
i:=hash_tableÆiÅ.following;
end;

end; (*I<HASHSIZE*)
end;


procedure print_table;
var l,i:integer;
x : ^occ_list;
begin
i:=top;
linenumber:=((linenumber div maxline)+1)*maxline;
while i<hashsize do
begin
(* CLOSE END OF OCC_LIST *)
hash_tableÆiÅ.last^.next:=nil;
if (linenumber mod maxline)=0 then newpage;
write(output,' ',hash_tableÆiÅ.id,' ');
l:=0;
x:=hash_tableÆiÅ.first;
repeat
if l>=15 then
begin
writeln(output);
linenumber:=linenumber+1;
if (linenumber mod maxline)=0 then newpage;
write(output,'              ');
l:=0;
end;
write(output,(x^.where):5);
if x^.decl then write(output,'*')
else write(output,' ');
l:=l+1;
x:=x^.next;
until x=nil;
writeln(output);
linenumber:=linenumber+1;
i:=hash_tableÆiÅ.following;
end;
i:=keywordtop;
linenumber:=((linenumber div maxline)+1)*maxline;
newpage;
while i<hashsize do
begin
if hash_tableÆiÅ.key_occ>0 then
writeln(output,' ',hash_tableÆiÅ.id,hash_tableÆiÅ.key_occ:8);
i:=hash_tableÆiÅ.following;
end;
end;


(*HOVEDPROGRAM*)
begin
init;
while not eof(infil) do
begin
while (state<>ident) and (not eof(infil)) do
begin
nextsymbol(symbol,symbolgroup);
state:=next_stateÆstate,symbolgroupÅ;
end;
while (state=ident) and (not eof(infil)) do
begin
add_to_id(newid,symbol);
nextsymbol(symbol,symbolgroup);
state:=next_stateÆstate,symbolgroupÅ;
end;
insert_id(newid,identifier);
end;
sort_table;
print_table;
if outputfile then close(output);
if table_full_at_line <> -1 then
writeln(output,nl,nl,nl,'***** warning: hash table overflow at line: '
,table_full_at_line :1 );
10:;
end.
▶EOF◀