comment ************************************************* analyzer.SIM (version 2.3) ============================ auteur: jean vaucher date : MAI 1995 ( adapte de simanal 8 juillet 1981) goal : this program analyses a simula program and gives a listing of all procedure and class headings along with the line numbers where they occur. - the new hardware representation for simula is assumed that is begin instead of "begin" in the old format. - the ndre external definitions are also accepted. mods : 9 july 1981 - added listing of parameter specification comments added april 1995: -------------------------- Version 2 can handle input lines of any length by using "inrecord" instead of inimage. (nov 1988 ??) - To ease parsing we implement allow Pascal like SET operations AND, OR and IN . ADDITIONS (may 1995): -------------------------- - We build a tree of all declarations and identifier use - NOT HANDLED: "this" and "qua" ****************************************************************; % added : possibility of reading in a file instead of sysin. when % creating Reader, initialise with Infile instantiation. % Charles De Lean June 27 1995. % reinitialisation of global variables in creation of reader. % Took away the outtext function. It should be called only if we want a trace. % Charles De Lean June 30,1995. % Problem with sy := nT if nT is too big. using copy instead. % Charles De Lean June 30, 1995. class analyzer; begin external class utilities; integer nligne; character C; Boolean EOF; ref(LLClass) Reader; class LLClass(filein);REF(InFile) filein; !CDL 27 June 1995; begin text t, image, t1, t2 ; boolean Overflow; EOF := FALSE; !CDL, June 30 1995; nligne:=0; image :- filein.image; t1 :- image.sub(1,1); t2 :- image.sub(2,10); Overflow := filein.inrecord; for nligne := nligne+1 while not filein.endfile do BEGIN if Overflow then t:- Image else t:- image.sub(1,filein.pos-1); if trace>2 then begin if filein.pos ne 1 then outimage; outint(nligne,5); outtext(" ="); outtext(t); outimage; end; ! OutText(t); !CDL 30 June 1995; ! OutImage; if t1="%" then begin resetDebugFlags(t2); t.setpos(0); end; while t.more do begin c:= t.getchar; if rank(c) < 32 then c:= ' '; detach end; if not Overflow then begin c := ' '; detach end; Overflow := filein.inrecord; END; c:= ';'; EOF := true; detach; error(" Dans LLClass: lecture apres EOF"); end *** LLClass ***; % ==================================================== % Debugging and feature flags; % Set from comment lines with double %% in cols 1-2. % % %%41x0 puts: % 4 -> trace % True -> SymbolTable (means BUILD symbol table) % printUses left unchanged % False -> printChains % ==================================================== integer trace; Boolean SymbolTable, ! = 4 ; printUses, ! = 8 ; printChains; ! =16 ; procedure resetDebugFlags (T); value T; text T; if T =/= notext and then T.getchar = '%' then begin character C; procedure setFlag(F); name F; boolean F; if T.more then begin C := T.getchar; if C = '1' then F := true else if C = '0' then F := false; end; if T.more then C := T.getchar; if digit(C) then trace := rank(C) - rank('0'); setFlag(SymbolTable); setFlag(printUses); setFlag(printChains); end; procedure traceMsg(Level,Msg); integer level; text Msg; if trace >= level then outline(Msg); ! ------------------------------------------------ ; integer comment_sy, ident_sy, begin_sy, end_sy, decl_sy, spec_sy, text_sy, class_sy, external_sy, is_sy, inspect_sy, when_sy, do_sy, otherwise_sy, if_sy, then_sy, else_sy, virtual_sy, array_sy, label_sy, procedure_sy, ref_sy, switch_sy, pv_sy, deux_points, comma, period, leftPar, rightPar, other_sy, fdf_sy ; integer ! Classes de symboles ; fin_d_enonce, fin_comment, fin_comment_sy, simple_decl, declar, decspec, punctuation, nonWords ; procedure init_sy; begin integer i, n, code; integer procedure NC; comment next_code ; if n = 32 then error("More than 32 SIMULA keywords") else begin n := n+1; nc:= code; code:=code*2 end; code:=1; array_sy :=nc; begin_sy :=nc; class_sy :=nc; comment_sy:=nc; deux_points:= nc; decl_sy :=nc; ! == bool, int, real, char, short, long ; do_sy :=nc; end_sy :=nc; else_sy :=nc; external_sy:=nc; fdf_sy :=nc; ident_sy :=nc; if_sy :=nc; inspect_sy:=nc; is_sy :=nc; label_sy :=nc; other_sy :=nc; otherwise_sy:=nc; procedure_sy:=nc; pv_sy :=nc; ref_sy :=nc; switch_sy :=nc; spec_sy :=nc; ! == name, value, hidden, protected ; then_sy :=nc; virtual_sy:=nc; when_sy :=nc; comma :=nc; leftpar :=nc; rightpar :=nc; period :=nc; fin_d_enonce:= fdf_sy + pv_sy + end_sy; fin_comment := fin_d_enonce + else_sy + when_sy + otherwise_sy;; simple_decl := decl_sy + ref_sy + external_sy ; declar := simple_decl + switch_sy + procedure_sy + class_sy ; decspec := declar - class_sy + array_sy + label_sy + spec_sy - external_sy ; punctuation := comma + period + deux_points + pv_sy + leftPar + rightPar + comment_sy ; nonWords := other_sy + punctuation ; for i := 0 step 1 until maxrank do charType(i) := other_sy; charType( rank(';') ) := pv_sy; charType( rank(':') ) := deux_points; charType( rank('!') ) := comment_sy; charType( rank(',') ) := comma; charType( rank('.') ) := period; charType( rank('(') ) := leftPar; charType( rank(')') ) := rightPar; end *** init_sy *** ; procedure init_table; begin table :- new table_class(107); inspect table do begin add("array", array_sy); add("begin", begin_sy); add("boolean", decl_sy); add("character",decl_sy); add("class", class_sy); add("comment", comment_sy); add("end", end_sy); add("external", external_sy); add("integer", decl_sy); add("is", is_sy); add("label", label_sy); add("long", decl_sy); add("name", spec_sy); add("procedure",procedure_sy); add("real", decl_sy); add("ref", ref_sy); add("short", decl_sy); add("switch", switch_sy); add("text", decl_sy); add("value", spec_sy); add("virtual", virtual_sy); add("if", if_sy); add("then", then_sy); add("else", else_sy); add("inspect", inspect_sy); add("when", when_sy); add("do", do_sy); add("otherwise",otherwise_sy); add("call", other_sy); add("detach", other_sy); add("false", other_sy); add("go", other_sy); add("to", other_sy); add("goto", other_sy); add("hidden", spec_sy); add("for", other_sy); add("if", other_sy); add("in", other_sy); add("inner", other_sy); add("new", other_sy); add("none", other_sy); add("notext", other_sy); add("protected", spec_sy); add("qua", period); ! <<=== to handle 'X qua Y.Z' like 'X.Y.Z' ; add("resume", other_sy); add("step", other_sy); add("then", other_sy); add("this", other_sy); add("true", other_sy); add("until", other_sy); add("while", other_sy); add("activate",other_sy); add("after", other_sy); add("at", other_sy); add("before", other_sy); add("delay", other_sy); add("prior", other_sy); add("reactivate",other_sy); add("and", other_sy); add("eq", other_sy); add("eqv", other_sy); add("ge", other_sy); add("gt", other_sy); add("imp", other_sy); add("le", other_sy); add("lt", other_sy); add("ne", other_sy); add("not", other_sy); add("or", other_sy); end; end *** init_table ***; ! ********************************************************************; ! ***************** hashtable of key words **************************; ! ********************************************************************; ref(table_class) table; class kword(t,code); text t; integer code; begin ref(kword) suc; end; class table_class(size); integer size; begin ref(kword) array index (1:size); integer i; integer procedure hash(t); text t; begin integer N, K; K := abs( minint // 16); t.Setpos(1); while t.More do begin N := 11*N + Rank(t.Getchar); IF N > K THEN N := rem( N, K); end; hash := randint(1, size, N); end of HASH; % integer procedure hash(t); text t; % hash := mod(rank(t.getchar)+t.length,size); procedure add (t,code); value t; text t; integer code; begin ref(kword) p,pp,k; integer i; i:= hash(t); k:- new kword(t,code); p:- index(i); if t<= p.t then index(i) :- k else begin while t > p.t do begin pp:-p; p:-p.suc end; pp.suc:-k; end; k.suc:-p; end ** add **; integer procedure lookup (t); text t; begin comment this procedure is expanded in-line where needed ; end ** lookup **; for i:= 1 step 1 until size do index(i) :- new kword(copy("~"),0); end ** table_class **; comment $p *** analize lexicale - G E T S Y *** *************************************** ; integer usc, nextUs; text Sy, Token, nextText, prefixe, reference ; integer array charType(0:maxrank); ref(Symbol) NextSymbol; Class Symbol(nU,nT,nTok); value nT; integer nU; text nT, nTok; ; integer procedure PeekSy; inspect NextSymbol do PeekSy:= usc otherwise begin integer U; text T,Tok; u := usc; T :- sy; Tok :- Token; sy :- copy(sy); getSy; NextSymbol :- new Symbol(usc,syText,Token); PeekSy := usc; usc := U; sy :- T; Token :- Tok; traceMsg(3,"Restore to " & sytext & ":" & intAsText(usc)); end; TEXT PROCEDURE syText; syText :- sy.Sub(1,sy.Pos-1); ! =======================================; procedure getSy; ! =======================================; inspect nextSymbol do begin usc := nU; sy :- Copy(nT); sy.setpos(nT.length+1); !CDL June 30 1995; Token :- nTok; nextSymbol :- none; if trace > 2 then outLine(" (" & syText & ":" & intAsText(usc) & ") "); end otherwise begin text t; ref(kword) p; PROCEDURE copyChar; BEGIN IF NOT sy.More then BEGIN TEXT T; T :- sy & Blanks(0.5* sy.Length); T.SetPos(sy.Pos); Sy :- T; END; sy.PutChar(c); Call(Reader) END; usc := other_sy; sy.SetPos(1); while c=' ' do call (Reader); if EOF then usc:= fdf_sy else if LETTER(c) then begin copyChar; while letter(c) or digit(c) or c='_' do begin copyChar end; ! *** in-line lookup *** ; t :- Token :- lowcase(copy(syText)); p :- table.index(table.hash(t)); while t > p.t do p:-p.suc; if t=p.t then usc:= p.code else usc:= ident_sy; if usc=ref_sy then begin reference :- blanks(32); while c <> '(' and not EOF do copyChar; copyChar; while c <> ')' and not EOF do begin if reference.more then reference.putchar(C); copyChar; end; reference :- lowcase(reference.strip); copyChar; end end else if DIGIT(c) then while digit(c) DO copyChar else if c=''' then begin copyChar ; copyChar ; while c <> ''' do copyChar; copyChar; end else if c='"' then begin l1: copyChar ; if c <> '"' and not EOF then goto l1; if not EOF then copyChar; if c='"' then goto l1; end else if c=':' then begin copyChar ; if c = '-' or c = '=' then begin copyChar; usc := other_sy; end; end else begin usc := charType(rank(c)); copyChar; end; if usc=comment_sy then begin while c ne ';' do call (Reader); if not EOF then call (Reader); getsy; end; if trace > 2 then outLine(" <" & sytext & ":" & intAsText(usc) & "> "); end ===---===---=== getsy ===---===---=== ; % ------------------------------- % UTILITAIRES % ------------------------------- integer margin, MARGIN1 = 8; procedure chercher (s); integer s; begin while usc<>fdf_sy and then not symbol_in (S) do getsy; end ** chercher **; Boolean procedure symbol_is(S); integer S; symbol_is := usc = S; Boolean procedure symbol_in(S); integer S; symbol_in := rem(S // usc,2) = 1 ; Boolean procedure set_in (usc,set); integer usc,set; set_in:= rem(set // usc,2) = 1 ; procedure Skip(Sy); integer Sy; if usc = Sy then getSy; text procedure intAsText(N); integer N; begin text T; intAsText :- T :- blanks( if N <10 then 1 else if N < 100 then 2 else if N < 1000 then 3 else if N < 10000 then 4 else if N < 1000000 then 6 else 10); T.putint(N); end; end -- analyzer ---;