+++ /dev/null
-# $Header$
-d=../../..
-h=$d/h
-PEM=$d/lib/pc_pem
-PEM_OUT=$d/lib/pc_pem.out
-
-HEAD=$h/em_spec.h $h/em_pseu.h $h/em_mnem.h $h/em_mes.h $h/pc_size.h
-LDFLAG=-i
-
-all: pem pem.out
-
-pem.out: pem.m
- apc -mint --t -o pem.out pem.m
-
-pem: pem.m
- apc $(LDFLAG) -o pem pem.m
-
-# pem.m is system dependent and may NOT be distributed
-pem.m: pem.p $(HEAD)
- -rm -f pem.m
- -if apc -I$h -O -c.m pem.p ; then :; else \
- acc -o move move.c ; move ; rm move move.[oskm] ; \
- fi
-
-cmp: pem
- cmp pem $(PEM)
-
-install: pem
- cp pem $(PEM)
-
-distr:
- ln pem.p pem22.p ; apc -mpdp -c.m -I$h pem22.p ; rm pem22.p
- ln pem.p pem24.p ; apc -mvax2 -c.m -I$h pem24.p ; rm pem24.p
-clean:
- -rm -f pem pem.out *.[os] *.old
-
-pr:
- @pr pem.p
-
-xref:
- xref pem.p^pr -h "XREF PEM.P"
-
-opr:
- make pr ^ opr
+++ /dev/null
-/* A program to move the file pem??.m to pem.m */
-/* Called when "apc pem.p" fails. It is assumed that the binary
- file is incorrect in that case and has to be created from the compact
- code file.
- This program selects the correct compact code file for each combination
- of word and pointer size.
- It will return an error code if the move failed
-*/
-main(argc) {
- char copy[100] ;
-
- if ( argc!=1 ) {
- printf("No arguments allowed\n") ;
- exit(1) ;
- }
-
- sprintf(copy,"cp pem%d%d.m pem.m", EM_WSIZE, EM_PSIZE) ;
- printf("%s\n",copy) ;
- return system(copy) ;
-}
+++ /dev/null
-#include <em_spec.h>
-#include <em_pseu.h>
-#include <em_mnem.h>
-#include <em_mes.h>
-#include <em_reg.h>
-#include <pc_size.h>
-
-{
- (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
-
- This product is part of the Amsterdam Compiler Kit.
-
- Permission to use, sell, duplicate or disclose this software must be
- obtained in writing. Requests for such permissions may be sent to
-
- Dr. Andrew S. Tanenbaum
- Wiskundig Seminarium
- Vrije Universiteit
- Postbox 7161
- 1007 MC Amsterdam
- The Netherlands
-
-}
-
-{if next line is included the compiler itself is written in standard pascal}
-{#define STANDARD 1}
-
-{Author: Johan Stevenson Version: 32}
-{$l- : no source line numbers}
-{$r- : no subrange checking}
-{$a- : no assertion checking}
-#ifdef STANDARD
-{$s+ : test conformancy to standard}
-#endif
-
-program pem(input,em,errors);
-{ This Pascal compiler produces EM code as described in
- - A.S.Tanenbaum, J.W.Stevenson & H. van Staveren,
- "Description of a machine architecture for use with
- block structured languages" Informatika rapport 81.
- NOTE: this version is modified to produce the modified EM code of
- januari 1981. it is not possible, using this compiler, to generate
- code for machines with 1 or 4 byte wordsize.
- A description of Pascal is given in
- - K.Jensen & N.Wirth, "PASCAL user manual and report", Springer-Verlag.
- Several options may be given in the normal pascal way. Moreover,
- a positive number may be used instead of + and -. The options are:
- a: interpret assertions (+)
- c: C-type strings allowed (-)
- d: type long may be used (-)
- i: controls the number of bits in integer sets (16)
- l: insert code to keep track of source lines (+)
- o: optimize (+)
- r: check subranges (+)
- s: accept only standard pascal programs (-)
- t: trace procedure entry and exit (-)
- u: treat '_' as letter (-)
-}
-{===================================================================}
-#ifdef STANDARD
-label 9999;
-#endif
-
-const
-{fundamental constants}
- MB1 = 7; MB2 = 15; {MB4 = 31}
- NB1 = 8; NB2 = 16; {NB4 = 32}
-
- MI1 = 127; MI2 = 32767; {MI4 = 2147483647}
- NI1 = 128; {NI2 = 32768} {NI4 = 2147483648}
-
- MU1 = 255; {MU2 = 65535} {MU4 = 4294967295}
- NU1 = 256; {NU2 = 65536} {NU4 = 4294967296}
-
-{maximal indices}
- idmax = 8;
- fnmax = 14;
- smax = 72;
-
-{opt values}
- off = 0;
- on = 1;
-
-{for push and pop: }
- global = false;
- local = true;
-
-{for sizeof and posaddr: }
- wordmult = false;
- wordpart = true;
-
-{ASCII characters}
- ascht = 9;
- ascnl = 10;
- ascvt = 11;
- ascff = 12;
- asccr = 13;
-
-{miscellaneous}
- maxcharord = 127; {maximal ordinal number of chars}
- maxargc = 13; {maximal index in argv}
- rwlim = 34; {number of reserved words}
- spaces = ' ';
-
-{-------------------------------------------------------------------}
-type
-{scalar types}
- symbol= (comma,semicolon,colon1,colon2,notsy,lbrack,ident,
- intcst,charcst,realcst,longcst,stringcst,nilcst,minsy,
- plussy,lparent,arrow,arraysy,recordsy,setsy,filesy,
- packedsy,progsy,labelsy,constsy,typesy,varsy,procsy,
- funcsy,beginsy,gotosy,ifsy,whilesy,repeatsy,forsy,
- withsy,casesy,becomes,starsy,divsy,modsy,slashsy,
- andsy,orsy,eqsy,nesy,gtsy,gesy,ltsy,
- lesy,insy,endsy,elsesy,untilsy,ofsy,dosy,
- downtosy,tosy,thensy,rbrack,rparent,period
- ); {the order is important}
- chartype= (lower,upper,digit,layout,tabch,
- quotech,dquotech,colonch,periodch,lessch,
- greaterch,lparentch,lbracech,
- {different entries}
- rparentch,lbrackch,rbrackch,commach,semich,arrowch,
- plusch,minch,slash,star,equal,
- {also symbols}
- others
- );
- standpf= (pread,preadln,pwrite,pwriteln,pput,pget,
- preset,prewrite,pnew,pdispose,ppack,punpack,
- pmark,prelease,ppage,phalt,
- {all procedures}
- feof,feoln,fabs,fsqr,ford,fchr,fpred,fsucc,fodd,
- ftrunc,fround,fsin,fcos,fexp,fsqt,flog,fatn
- {all functions}
- ); {the order is important}
- libmnem= (ELN ,EFL ,CLS ,WDW , {input and output}
- OPN ,GETX,RDI ,RDC ,RDR ,RDL ,RLN ,
- {on inputfiles}
- CRE ,PUTX,WRI ,WSI ,WRC ,WSC ,WRS ,WSS ,WRB ,
- WSB ,WRR ,WSR ,WRL, WSL, WRF ,WRZ ,WSZ ,WLN ,PAG ,
- {on outputfiles, order important}
- ABR ,RND ,SINX,COSX,EXPX,SQT ,LOG ,ATN ,
- {floating point}
- ABI ,ABL ,BCP ,BTS ,NEWX,SAV ,RST ,INI ,HLT ,
- ASS ,GTO ,PAC ,UNP, DIS, ASZ, MDI, MDL
- {miscellaneous}
- );
- structform= (scalar,subrange,pointer,power,files,arrays,carray,
- records,variant,tag); {order important}
- structflag= (spack,withfile);
- identflag= (refer,used,assigned,noreg,loopvar,samesect);
- idclass= (types,konst,vars,field,carrbnd,proc,func);
- kindofpf= (standard,formal,actual,extern,varargs,forward);
- where= (blck,rec,wrec);
- attrkind= (cst,fixed,pfixed,loaded,ploaded,indexed);
- twostruct= (eq,subeq,ir,ri,il,li,lr,rl,es,se,noteq); {order important}
-
-{subrange types}
- rwrange= 0..rwlim;
- byte= 0..MU1;
-
-{pointer types}
- sp= ^structure;
- ip= ^identifier;
- lp= ^labl;
- bp= ^blockinfo;
- np= ^nameinfo;
-
-{set types}
- sos= set of symbol;
- setofids= set of idclass;
- formset= set of structform;
- sflagset= set of structflag;
- iflagset= set of identflag;
-
-{array types}
- idarr=packed array[1..idmax] of char;
- fnarr=packed array[1..fnmax] of char;
-
-{record types}
- position=record {the addr info of certain variable}
- ad:integer; {for locals it is the byte offset}
- lv:integer; {the level of the beast}
- end;
-
-{records of type attr are used to remember qualities of
- expression parts to delay the loading of them.
- Reasons to delay the loading of one word constants:
- - bound checking
- - set building.
- Reasons to delay the loading of direct accessible objects:
- - efficient handling of read/write
- - efficient handling of the with statement.
-}
- attr=record
- asp:sp; {type of expression}
- packbit:boolean; {true for part of packed structure}
- ak:attrkind; {access method}
- pos:position; {lv and ad}
- {If ak=cst then the value is stored in ad}
- end;
-
- nameinfo=record {one for each separate name space}
- nlink:np; {one deeper}
- fname:ip; {first name: root of tree}
- case occur:where of
- blck:();
- rec: ();
- wrec:(wa:attr) {name space opened by with statement}
- end;
-
- blockinfo=record {all info of the current procedure}
- nextbp:bp; {pointer to blockinfo of surrounding proc}
- reglb:integer; {data location counter (from begin of proc) }
- minlb:integer; {keeps track of minimum of reglb}
- ilbno:integer; {number of last local label}
- forwcount:integer; {number of not yet specified forward procs}
- lchain:lp; {first label: header of chain}
- end;
-
- structure=record
- size:integer; {size of structure in bytes}
- sflag:sflagset; {flag bits}
- case form:structform of
- scalar :(scalno:integer; {number of range descriptor}
- fconst:ip {names of constants}
- );
- subrange:(min,max:integer; {lower and upper bound}
- rangetype:sp; {type of bounds}
- subrno:integer {number of subr descriptor}
- );
- pointer :(eltype:sp); {type of pointed object}
- power :(elset:sp); {type of set elements}
- files :(filtype:sp); {type of file elements}
- arrays,carray:
- (aeltype:sp; {type of array elements}
- inxtype:sp; {type of array index}
- arpos:position {position of array descriptor}
- );
- records :(fstfld:ip; {points to first field}
- tagsp:sp {points to tag if present}
- );
- variant :(varval:integer; {tag value for this variant}
- nxtvar:sp; {next equilevel variant}
- subtsp:sp {points to tag for sub-case}
- );
- tag :(fstvar:sp; {first variant of case}
- tfldsp:sp {type of tag}
- )
- end;
-
- identifier=record
- idtype:sp; {type of identifier}
- name:idarr; {name of identifier}
- llink,rlink:ip; {see enterid,searchid}
- next:ip; {used to make several chains}
- iflag:iflagset; {several flag bits}
- case klass:idclass of
- types :();
- konst :(value:integer); {for integers the value is
- computed and stored in this field.
- For strings and reals an assembler constant is
- defined labeled '.1', '.2', ... This '.' number is then
- stored in value. For reals value may be negated to
- indicate that the opposite of the assembler constant
- is needed. }
- vars :(vpos:position); {position of var}
- field :(foffset:integer); {offset to begin of record}
- carrbnd :(); {idtype points to carray struct}
- proc,func:
- (case pfkind:kindofpf of
- standard:(key:standpf); {identification}
- formal,actual,forward,extern,varargs:
- (pfpos:position; {lv gives declaration level.
- ad is relevant for formal pf's and for
- functions (no conflict!!).
- for functions: ad is the result address.
- for formal pf's: ad is the address of the
- descriptor }
- pfno:integer; {unique pf number}
- maxlb:integer; {bytes of parameters}
- parhead:ip {head of parameter list}
- )
- )
- end;
-
- labl=record
- nextlp:lp; {chain of labels}
- seen:boolean;
- labval:integer; {label number given by the programmer}
- labname:integer; {label number given by the compiler}
- labdlb:integer {zero means only locally used,
- otherwise dlbno of label information}
- end;
-
-{-------------------------------------------------------------------}
-var {the most frequent used externals are declared first}
- sy:symbol; {last symbol}
- a:attr; {type,access method,position,value of expr}
-{returned by insym}
- ch:char; {last character}
- chsy:chartype; {type of ch, used by insym}
- val:integer; {if last symbol is an constant }
- ix:integer; {string length}
- eol:boolean; {true of current ch is a space, replacing a newline}
- zerostring:boolean; {true for strings in " "}
- id:idarr; {if last symbol is an identifier}
-{some counters}
- lino:integer; {line number on code file (1..n) }
- dlbno:integer; {number of last global number}
- holeb:integer; {size of hol-area}
- level:integer; {current static level}
- argc:integer; {index in argv}
- lastpfno:integer; {unique pf number counter}
- copt:integer; {C-type strings allowed if on}
- dopt:integer; {longs allowed if on}
- iopt:integer; {number of bits in sets with base integer}
- sopt:integer; {standard option}
- srcchno:integer; {column count for errors}
- srclino:integer; {source line number after preprocessing}
- srcorig:integer; {source line number before preprocessing}
- fildlb:integer; {label number of source string}
-{pointers pointing to standard types}
- realptr,intptr,textptr,nullset,boolptr:sp;
- charptr,nilptr,zeroptr,procptr,longptr:sp;
-{flags}
- giveline:boolean; {give source line number at next statement}
- including:boolean; {no LIN's for included code}
- eofexpected:boolean; {quit without error if true (nextch) }
- main:boolean; {complete programme or a module}
- intypedec:boolean; {true if nested in typedefinition}
- fltused:boolean; {true if floating point instructions are used}
- seconddot:boolean; {indicates the second dot of '..'}
-{pointers}
- fwptr:ip; {head of chain of forward reference pointers}
- progp:ip; {program identifier}
- currproc:ip; {current procedure/function ip (see selector)}
- top:np; {pointer to the most recent name space}
- lastnp:np; {pointer to nameinfo of last searched ident }
-{records}
- b:blockinfo; {all info to be stacked at pfdeclaration}
- fa:attr; {attr for current file name}
-{arrays}
- sizes:array[0 .. sz_last] of integer;
- strbuf:array[1..smax] of char;
- rw:array[rwrange] of idarr;
- {reserved words}
- frw:array[0..idmax] of integer;
- {indices in rw}
- rsy:array[rwrange] of symbol;
- {symbol for reserved words}
- cs:array[char] of chartype;
- {chartype of a character}
- csy:array[rparentch..equal] of symbol;
- {symbol for single character symbols}
- lmn:array[libmnem] of packed array[1..4] of char;
- {mnemonics of pascal library routines}
- opt:array['a'..'z'] of integer;
- forceopt:array['a'..'z'] of boolean;
- {26 different options}
- undefip:array[idclass] of ip;
- {used in searchid}
- iop:array[boolean] of ip;
- {false:standard input, true:standard output}
- argv:array[0..maxargc] of
- record name:idarr; ad:integer end;
- {save here the external heading names}
-{files}
- em:file of byte; {the EM code}
- errors:text; {the compilation errors}
- source:fnarr;
-
-{===================================================================}
-
-procedure initpos(var p:position);
-begin p.lv:=level; p.ad:=0; end;
-
-procedure inita(fsp:sp; fad:integer);
-begin with a do begin
- asp:=fsp; packbit:=false; ak:=fixed; pos.ad:=fad; pos.lv:=level;
-end end;
-
-function newip(kl:idclass; n:idarr; idt:sp; nxt:ip):ip;
-var p:ip; f:iflagset;
-begin f:=[];
- case kl of
- types,carrbnd: {similar structure}
- new(p,types);
- konst:
- begin new(p,konst); p^.value:=0 end;
- vars:
- begin new(p,vars); f:=[used,assigned]; initpos(p^.vpos) end;
- field:
- begin new(p,field); p^.foffset:=0 end;
- proc,func: {same structure}
- begin new(p,proc,actual); p^.pfkind:=actual;
- initpos(p^.pfpos); p^.pfno:=0; p^.maxlb:=0; p^.parhead:=nil;
- end
- end;
- p^.name:=n; p^.klass:=kl; p^.idtype:=idt; p^.next:=nxt;
- p^.llink:=nil; p^.rlink:=nil; p^.iflag:=f; newip:=p
-end;
-
-function newsp(sf:structform; sz:integer):sp;
-var p:sp; sflag:sflagset;
-begin sflag:=[];
- case sf of
- scalar:
- begin new(p,scalar); p^.scalno:=0; p^.fconst:=nil end;
- subrange:
- new(p,subrange);
- pointer:
- begin new(p,pointer); p^.eltype:=nil end;
- power:
- new(p,power);
- files:
- begin new(p,files); sflag:=[withfile] end;
- arrays,carray: {same structure}
- new(p,arrays);
- records:
- new(p,records);
- variant:
- new(p,variant);
- tag:
- new(p,tag);
- end;
- p^.form:=sf; p^.size:=sz; p^.sflag:=sflag; newsp:=p;
-end;
-
-function sizeof(fsp:sp; partword:boolean):integer;
-var s:integer;
-begin if fsp=nil then s:=0 else s:=fsp^.size;
- if s<>0 then
- if partword and (s<sz_word) then
- while sz_word mod s <> 0 do s:=s+1
- else
- while s mod sz_word <> 0 do s:=s+1;
- sizeof:=s
-end;
-
-function formof(fsp:sp; forms:formset):boolean;
-begin if fsp=nil then formof:=false else formof:=fsp^.form in forms end;
-
-{===================================================================}
-
-procedure put1(b:byte);
-begin write(em,b) end;
-
-procedure put2(i:integer);
-var i1,i2:byte;
-begin
- if i<0 then
- begin i:=-(i+1); i1:=MU1 - i mod NU1; i2:=MU1 - i div NU1 end
- else
- begin i1:=i mod NU1; i2:=i div NU1 end;
- put1(i1); put1(i2)
-end;
-
-procedure argend;
-begin put1(sp_cend) end;
-
-procedure argcst(i:integer);
-begin
- if (i >= -sp_zcst0) and (i < sp_ncst0-sp_zcst0) then
- put1(i + sp_zcst0 + sp_fcst0)
- else
- begin put1(sp_cst2); put2(i) end
-end;
-
-procedure argnil;
-begin put1(sp_icon); argcst(sz_addr); argcst(1); put1(ord('0')) end;
-
-procedure argilb(i:integer);
-begin
- if i<=MU1 then
- begin put1(sp_ilb1); put1(i) end
- else
- begin put1(sp_ilb2); put2(i) end
-end;
-
-procedure argdlb(i:integer);
-begin
- if i<=MU1 then
- begin put1(sp_dlb1); put1(i) end
- else
- begin put1(sp_dlb2); put2(i) end
-end;
-
-procedure argident(var a:idarr);
-var i,j:integer;
-begin i:=idmax;
- while (a[i]=' ') and (i>1) do i:=i-1;
- put1(sp_pnam); argcst(i);
- for j:=1 to i do put1(ord(a[j]))
-end;
-
-procedure genop(b:byte);
-begin put1(b); lino:=lino+1 end;
-
-procedure gencst(b:byte; i:integer);
-begin genop(b); argcst(i) end;
-
-procedure gensp(m:libmnem; s:integer);
-var i:integer;
-begin genop(op_cal); put1(sp_pnam); argcst(4);
- for i:=1 to 4 do put1(ord(lmn[m][i]));
- gencst(op_asp,s)
-end;
-
-procedure genpnam(b:byte; fip:ip);
-var n:idarr; i,j:integer;
-begin
- if fip^.pfpos.lv<=1 then n:=fip^.name else
- begin n:='_ '; j:=1; i:=fip^.pfno;
- while i<>0 do
- begin j:=j+1; n[j]:=chr(i mod 10 + ord('0')); i:=i div 10 end;
- end;
- genop(b); argident(n)
-end;
-
-procedure genasp(m:byte);
-begin gencst(m,sizeof(a.asp,wordmult)) end;
-
-procedure genlin;
-begin giveline:=false;
- if opt['l']<>off then if main then gencst(op_lin,srcorig)
-end;
-
-procedure genreg(sz,ad,regval:integer);
-begin gencst(ps_mes,ms_reg);
- argcst(ad); argcst(sz); argcst(regval); argend
-end;
-
-procedure laedlb(d:integer);
-begin genop(op_lae); argdlb(d) end;
-
-procedure exchange(l1,l2:integer);
-var d1,d2:integer;
-begin d1:=l2-l1; d2:=lino-l2;
- if (d1<>0) and (d2<>0) then
- begin gencst(ps_exc,d1); argcst(d2) end
-end;
-
-procedure newilb(i:integer);
-begin lino:=lino+1;
- if i<sp_nilb0 then put1(i+sp_filb0) else argilb(i)
-end;
-
-function newdlb:integer;
-begin lino:=lino+1; dlbno:=dlbno+1; argdlb(dlbno); newdlb:=dlbno end;
-
-function romstr(typ:byte; siz:integer):integer;
-var i:integer;
-begin romstr:=newdlb; genop(ps_rom);
- put1(typ); if typ<>sp_scon then argcst(siz); argcst(ix);
- for i:=1 to ix do put1(ord(strbuf[i])); argend
-end;
-
-{===================================================================}
-
-procedure error(err:integer);
-{as you will notice, all error numbers are preceded by '+' and '0' to
- ease their renumbering in case of new errornumbers.
-}
-begin writeln(errors,err,srclino,srcchno);
- if err>0 then begin gencst(ps_mes,ms_err); argend end
-end;
-
-procedure errid(err:integer; var id:idarr);
-begin write(errors,'''',id); error(err) end;
-
-procedure errint(err:integer; i:integer);
-begin write(errors,i:1); error(err) end;
-
-procedure errasp(err:integer);
-begin if a.asp<>nil then begin error(err); a.asp:=nil end end;
-
-procedure teststandard;
-begin if sopt<>off then error(-(+01)) end;
-
-procedure enterid(fip: ip);
-{enter id pointed at by fip into the name-table,
- which on each declaration level is organised as
- an unbalanced binary tree}
-var nam:idarr; lip,lip1:ip; lleft,again:boolean;
-begin nam:=fip^.name; again:=false; assert nam[1]<>' ';
- lip:=top^.fname;
- if lip=nil then top^.fname:=fip else
- begin
- repeat lip1:=lip;
- if lip^.name>nam then
- begin lip:=lip^.llink; lleft:=true end
- else
- begin if lip^.name=nam then again:=true; {name conflict}
- lip:=lip^.rlink; lleft:=false;
- end;
- until lip=nil;
- if lleft then lip1^.llink:=fip else lip1^.rlink:=fip
- end;
- fip^.llink:=nil; fip^.rlink:=nil;
- if again then errid(+02,nam);
-end;
-
-{===================================================================}
-
-procedure trace(tname:idarr; fip:ip; var namdlb:integer);
-var i:integer;
-begin
- if opt['t']<>off then
- begin
- if namdlb=0 then
- begin namdlb:=newdlb; genop(ps_rom); put1(sp_scon); argcst(8);
- for i:=1 to 8 do put1(ord(fip^.name[i])); argend;
- end;
- laedlb(namdlb); genop(op_cal); argident(tname);
- gencst(op_asp,sz_addr);
- end;
-end;
-
-procedure expandnullset(fsp:sp);
-var s:integer;
-begin s:=sizeof(fsp,wordmult)-sz_word;
- if s<>0 then gencst(op_zer,s); a.asp:=fsp
-end;
-
-procedure push(local:boolean; ad:integer; sz:integer);
-begin assert sz mod sz_word = 0;
- if sz=sz_word then
- if local then gencst(op_lol,ad) else gencst(op_loe,ad)
- else if sz=2*sz_word then
- if local then gencst(op_ldl,ad) else gencst(op_lde,ad)
- else
- begin if local then gencst(op_lal,ad) else gencst(op_lae,ad);
- gencst(op_loi,sz)
- end
-end;
-
-procedure pop(local:boolean; ad:integer; sz:integer);
-begin assert sz mod sz_word = 0;
- if sz=sz_word then
- if local then gencst(op_stl,ad) else gencst(op_ste,ad)
- else if sz=2*sz_word then
- if local then gencst(op_sdl,ad) else gencst(op_sde,ad)
- else
- begin if local then gencst(op_lal,ad) else gencst(op_lae,ad);
- gencst(op_sti,sz)
- end
-end;
-
-procedure lexaddr(lv:integer; ad:integer);
-begin assert level>=lv;
- if ad>=0 then gencst(op_lxa,level-lv) else gencst(op_lxl,level-lv);
- gencst(op_adp,ad)
-end;
-
-procedure loadpos(var p:position; sz:integer);
-begin with p do
- if lv<=0 then push(global,ad,sz) else
- if lv=level then push(local,ad,sz) else
- begin lexaddr(lv,ad); gencst(op_loi,sz) end;
-end;
-
-procedure descraddr(var p:position);
-begin if p.lv=0 then laedlb(p.ad) else loadpos(p,sz_addr) end;
-
-procedure loadaddr;
-begin with a,pos do begin
- case ak of
- fixed:
- if lv<=0 then gencst(op_lae,ad) else
- if lv=level then gencst(op_lal,ad) else lexaddr(lv,ad);
- pfixed:
- loadpos(pos,sz_addr);
- ploaded:
- ;
- indexed:
- gencst(op_aar,sz_word);
- end; {case}
- ak:=ploaded;
-end end;
-
-procedure load;
-var sz:integer;
-begin with a do begin sz:=sizeof(asp,packbit);
- if asp<>nil then
- case ak of
- cst:
- gencst(op_loc,pos.ad); {only one-word scalars}
- fixed:
- loadpos(pos,sz);
- pfixed:
- begin loadpos(pos,sz_addr); gencst(op_loi,sz) end;
- loaded:
- ;
- ploaded:
- gencst(op_loi,sz);
- indexed:
- gencst(op_lar,sz_word);
- end; {case}
- ak:=loaded;
-end end;
-
-procedure store;
-var sz:integer;
-begin with a,pos do begin sz:=sizeof(asp,packbit);
- if asp<>nil then
- case ak of
- fixed:
- if lv<=0 then pop(global,ad,sz) else
- if level=lv then pop(local,ad,sz) else
- begin lexaddr(lv,ad); gencst(op_sti,sz) end;
- pfixed:
- begin loadpos(pos,sz_addr); gencst(op_sti,sz) end;
- ploaded:
- gencst(op_sti,sz);
- indexed:
- gencst(op_sar,sz_word);
- end; {case}
-end end;
-
-procedure fieldaddr(off:integer);
-begin with a do
- if (ak=fixed) and not packbit then pos.ad:=pos.ad+off else
- begin loadaddr; gencst(op_adp,off) end
-end;
-
-procedure loadcheap;
-begin if formof(a.asp,[arrays..records]) then loadaddr else load end;
-
-{===================================================================}
-
-procedure nextch;
-begin
- eol:=eoln(input); read(input,ch); srcchno:=srcchno+1; chsy:=cs[ch];
-end;
-
-procedure nextln;
-begin
- if eof(input) then
- begin
- if not eofexpected then error(+03) else
- if fltused then begin gencst(ps_mes,ms_flt); argend end;
-#ifdef STANDARD
- goto 9999
-#else
- halt
-#endif
- end;
- srcchno:=0; srclino:=srclino+1;
- if not including then
- begin srcorig:=srcorig+1; giveline:=true end;
-end;
-
-procedure options(normal:boolean);
-var ci:char; i:integer;
-
-procedure getc;
-begin if normal then nextch else read(errors,ch) end;
-
-begin
- repeat getc;
- if (ch>='a') and (ch<='z') then
- begin ci:=ch; getc; i:=0;
- if ch='+' then begin i:=1; getc end else
- if ch='-' then getc else
- if cs[ch]=digit then
- repeat i:=i*10 + ord(ch) - ord('0'); getc;
- until cs[ch]<>digit
- else i:=-1;
- if i>=0 then
- if not normal then
- begin forceopt[ci]:=true; opt[ci]:=i end
- else
- if not forceopt[ci] then opt[ci]:=i;
- end;
- until ch<>',';
-end;
-
-procedure linedirective;
-var i:integer; fname:fnarr;
-begin
- repeat nextch until (ch='"') or eol;
- if eol then error(+04) else
- begin nextch; i:=0;
- while (ch<>'"') and not eol do
- begin
- if ch='/' then i:=0 else
- begin i:=i+1; if i<=fnmax then fname[i]:=ch end;
- nextch
- end;
- while i<fnmax do begin i:=i+1; fname[i]:=' ' end;
- including:=fname<>source; while not eol do nextch
- end;
-end;
-
-procedure putdig;
-begin ix:=ix+1; if ix<=smax then strbuf[ix]:=ch; nextch end;
-
-procedure inident;
-label 1;
-var i,k:integer;
-begin k:=0; id:=spaces;
- repeat
- if chsy=upper then ch:=chr(ord(ch)-ord('A')+ord('a'));
- if k<idmax then begin k:=k+1; id[k]:=ch end;
- nextch
- until chsy>digit;
- {lower=0,upper=1,digit=2. ugly but fast}
- for i:=frw[k-1] to frw[k] - 1 do
- if rw[i]=id then
- begin sy:=rsy[i]; goto 1 end;
- sy:=ident;
-1:
-end;
-
-procedure innumber;
-label 1;
-const imax = 10;
- maxintstring = '0000032767';
- maxlongstring = '2147483647';
-var i,j:integer;
- is:packed array[1..imax] of char;
-begin ix:=0; sy:=intcst; val:=0;
- repeat putdig until chsy<>digit;
- if (ch='.') or (ch='e') or (ch='E') then
- begin
- if ch='.' then
- begin putdig;
- if ch='.' then
- begin seconddot:=true; ix:=ix-1; goto 1 end;
- if chsy<>digit then error(+05) else
- repeat putdig until chsy<>digit;
- end;
- if (ch='e') or (ch='E') then
- begin putdig;
- if (ch='+') or (ch='-') then putdig;
- if chsy<>digit then error(+06) else
- repeat putdig until chsy<>digit;
- end;
- if ix>smax then begin error(+07); ix:=smax end;
- sy:=realcst; fltused:=true; val:=romstr(sp_fcon,sz_real);
- end;
-1:if (chsy=lower) or (chsy=upper) then teststandard;
- if sy=intcst then
- if ix>imax then error(+08) else
- begin is:='0000000000'; i:=ix; j:=imax;
- repeat is[j]:=strbuf[i]; j:=j-1; i:=i-1 until i=0;
- if is<=maxintstring then
- repeat j:=j+1; val:=val*10 - ord('0') + ord(is[j]) until j=imax
- else if (is<=maxlongstring) and (dopt<>off) then
- begin sy:=longcst; val:=romstr(sp_icon,sz_long) end
- else error(+09)
- end
-end;
-
-procedure instring(qc:char);
-begin ix:=0; zerostring:=qc='"';
- repeat
- repeat nextch; ix:=ix+1; if ix<=smax then strbuf[ix]:=ch;
- until (ch=qc) or eol;
- if ch=qc then nextch else error(+010);
- until ch<>qc;
- if not zerostring then
- begin ix:=ix-1; if ix=0 then error(+011) end
- else
- begin strbuf[ix]:=chr(0); if copt=off then error(+012) end;
- if (ix=1) and not zerostring then
- begin sy:=charcst; val:=ord(strbuf[1]) end
- else
- begin if ix>smax then begin error(+013); ix:=smax end;
- sy:=stringcst; val:=romstr(sp_scon,0);
- end
-end;
-
-procedure incomment;
-var stopc:char;
-begin nextch; stopc:='}';
- if ch='$' then options(true);
- while (ch<>'}') and (ch<>stopc) do
- begin stopc:='}'; if ch='*' then stopc:=')';
- if eol then nextln; nextch
- end;
- if ch<>'}' then teststandard;
- nextch
-end;
-
-procedure insym;
- {read next basic symbol of source program and return its
- description in the global variables sy, op, id, val and ix}
-label 1;
-begin
-1:case chsy of
- tabch:
- begin srcchno:=srcchno - srcchno mod 8 + 8; nextch; goto 1 end;
- layout:
- begin if eol then nextln; nextch; goto 1 end;
- lower,upper: inident;
- digit: innumber;
- quotech,dquotech:
- instring(ch);
- colonch:
- begin nextch;
- if ch='=' then begin sy:=becomes; nextch end else sy:=colon1
- end;
- periodch:
- begin nextch;
- if seconddot then begin seconddot:=false; sy:=colon2 end else
- if ch='.' then begin sy:=colon2; nextch end else sy:=period
- end;
- lessch:
- begin nextch;
- if ch='=' then begin sy:=lesy; nextch end else
- if ch='>' then begin sy:=nesy; nextch end else sy:=ltsy
- end;
- greaterch:
- begin nextch;
- if ch='=' then begin sy:=gesy; nextch end else sy:=gtsy
- end;
- lparentch:
- begin nextch;
- if ch<>'*' then sy:=lparent else
- begin teststandard; incomment; goto 1 end;
- end;
- lbracech:
- begin incomment; goto 1 end;
- rparentch,lbrackch,rbrackch,commach,semich,arrowch,
- plusch,minch,slash,star,equal:
- begin sy:=csy[chsy]; nextch end;
- others:
- begin
- if (ch='#') and (srcchno=1) then linedirective else
- begin error(+014); nextch end;
- goto 1
- end;
- end {case}
-end;
-
-procedure nextif(fsy:symbol; err:integer);
-begin if sy=fsy then insym else error(-err) end;
-
-function find1(sys1,sys2:sos; err:integer):boolean;
-{symbol of sys1 expected. return true if sy in sys1}
-begin
- if not (sy in sys1) then
- begin error(err); while not (sy in sys1+sys2) do insym end;
- find1:=sy in sys1
-end;
-
-function find2(sys1,sys2:sos; err:integer):boolean;
-{symbol of sys1+sys2 expected. return true if sy in sys1}
-begin
- if not (sy in sys1+sys2) then
- begin error(err); repeat insym until sy in sys1+sys2 end;
- find2:=sy in sys1
-end;
-
-function find3(sy1:symbol; sys2:sos; err:integer):boolean;
-{symbol sy1 or one of sys2 expected. return true if sy1 found and skip it}
-begin find3:=true;
- if not (sy in [sy1]+sys2) then
- begin error(err); repeat insym until sy in [sy1]+sys2 end;
- if sy=sy1 then insym else find3:=false
-end;
-
-function endofloop(sys1,sys2:sos; sy3:symbol; err:integer):boolean;
-begin endofloop:=false;
- if find2(sys2+[sy3],sys1,err) then nextif(sy3,err+1)
- else endofloop:=true;
-end;
-
-function lastsemicolon(sys1,sys2:sos; err:integer):boolean;
-begin lastsemicolon:=true;
- if not endofloop(sys1,sys2,semicolon,err) then
- if find2(sys2,sys1,err+2) then lastsemicolon:=false
-end;
-
-{===================================================================}
-
-function searchid(fidcls: setofids):ip;
-{search for current identifier symbol in the name table}
-label 1;
-var lip:ip; ic:idclass;
-begin lastnp:=top;
- while lastnp<>nil do
- begin lip:=lastnp^.fname;
- while lip<>nil do
- if lip^.name=id then
- if lip^.klass in fidcls then
- begin
- if lip^.klass=vars then if lip^.vpos.lv<>level then
- lip^.iflag:=lip^.iflag+[noreg];
- goto 1
- end
- else lip:=lip^.rlink
- else
- if lip^.name< id then lip:=lip^.rlink else lip:=lip^.llink;
- lastnp:=lastnp^.nlink;
- end;
- errid(+015,id);
- if types in fidcls then ic:=types else
- if vars in fidcls then ic:=vars else
- if konst in fidcls then ic:=konst else
- if proc in fidcls then ic:=proc else
- if func in fidcls then ic:=func else ic:=field;
- lip:=undefip[ic];
-1:
- searchid:=lip
-end;
-
-function searchsection(fip: ip):ip;
-{to find record fields and forward declared procedure id's
- -->procedure pfdeclaration
- -->procedure selector}
-label 1;
-begin
- while fip<>nil do
- if fip^.name=id then goto 1 else
- if fip^.name< id then fip:=fip^.rlink else fip:=fip^.llink;
-1: searchsection:=fip
-end;
-
-function searchlab(flp:lp; val:integer):lp;
-label 1;
-begin
- while flp<>nil do
- if flp^.labval=val then goto 1 else flp:=flp^.nextlp;
-1:searchlab:=flp
-end;
-
-procedure opconvert(ts:twostruct);
-var op:integer;
-begin with a do begin genasp(op_loc);
- case ts of
- ir, lr: begin asp:=realptr; op:=op_cif; fltused:=true end;
- ri: begin asp:=intptr ; op:=op_cfi; fltused:=true end;
- rl: begin asp:=longptr; op:=op_cfi; fltused:=true end;
- li: begin asp:=intptr ; op:=op_cii end;
- il: begin asp:=longptr; op:=op_cii end;
- end;
- genasp(op_loc); genop(op)
-end end;
-
-procedure negate;
-begin if a.asp=realptr then genasp(op_ngf) else genasp(op_ngi) end;
-
-function desub(fsp:sp):sp;
-begin if formof(fsp,[subrange]) then fsp:=fsp^.rangetype; desub:=fsp end;
-
-function nicescalar(fsp:sp):boolean;
-begin
- if fsp=nil then nicescalar:=true else
- nicescalar:=(fsp^.form=scalar) and (fsp<>realptr) and (fsp<>longptr)
-end;
-
-function bounded(fsp:sp):boolean;
-begin bounded:=false;
- if fsp<>nil then
- if fsp^.form=subrange then bounded:=true else
- if fsp^.form=scalar then bounded:=fsp^.fconst<>nil
-end;
-
-procedure bounds(fsp:sp; var fmin,fmax:integer);
-begin
- if fsp=nil then
- begin fmin:=0; fmax:=0 end
- else
- case fsp^.form of
- subrange:
- begin fmin:=fsp^.min; fmax:=fsp^.max end;
- scalar:
- begin fmin:=0; fmax:=fsp^.fconst^.value end
- end
-end;
-
-procedure genrck(fsp:sp);
-var min,max,sno:integer;
-begin
- if opt['r']<>off then if bounded(fsp) then
- begin
- if fsp^.form=scalar then sno:=fsp^.scalno else sno:=fsp^.subrno;
- if sno=0 then
- begin bounds(fsp,min,max); sno:=newdlb;
- gencst(ps_rom,min); argcst(max); argend;
- if fsp^.form=scalar then fsp^.scalno:=sno else fsp^.subrno:=sno
- end;
- laedlb(sno); gencst(op_rck,sz_word);
- end
-end;
-
-procedure checkbnds(fsp:sp);
-var min1,max1,min2,max2:integer;
-begin
- if bounded(fsp) then
- if not bounded(a.asp) then genrck(fsp) else
- begin bounds(fsp,min1,max1); bounds(a.asp,min2,max2);
- if (min2<min1) or (max2>max1) then
- genrck(fsp);
- end;
- a.asp:=fsp;
-end;
-
-function eqstruct(p,q:sp):boolean;
-begin eqstruct:=(p=q) or (p=nil) or (q=nil) end;
-
-function string(fsp:sp):boolean;
-var lsp:sp;
-begin string:=false;
- if formof(fsp,[arrays]) then
- if eqstruct(fsp^.aeltype,charptr) then
- if spack in fsp^.sflag then
- begin lsp:=fsp^.inxtype;
- if lsp=nil then string:=true else
- if lsp^.form=subrange then
- if lsp^.rangetype=intptr then
- if lsp^.min=1 then
- string:=true
- end
-end;
-
-function compat(p,q:sp):twostruct;
-begin compat:=noteq;
- if eqstruct(p,q) then compat:=eq else
- begin p:=desub(p); q:=desub(q);
- if eqstruct(p,q) then compat:=subeq else
- if p^.form=q^.form then
- case p^.form of
- scalar:
- if (p=intptr) and (q=realptr) then compat:=ir else
- if (p=realptr) and (q=intptr) then compat:=ri else
- if (p=intptr) and (q=longptr) then compat:=il else
- if (p=longptr) and (q=intptr) then compat:=li else
- if (p=longptr) and (q=realptr) then compat:=lr else
- if (p=realptr) and (q=longptr) then compat:=rl else
- ;
- pointer:
- if (p=nilptr) or (q=nilptr) then compat:=eq;
- power:
- if p=nullset then compat:=es else
- if q=nullset then compat:=se else
- if compat(p^.elset,q^.elset) <= subeq then
- if p^.sflag=q^.sflag then compat:=eq;
- arrays:
- if string(p) and string(q) and (p^.size=q^.size) then compat:=eq;
- files,carray,records: ;
- end;
- end
-end;
-
-procedure checkasp(fsp:sp; err:integer);
-var ts:twostruct;
-begin
- ts:=compat(a.asp,fsp);
- case ts of
- eq:
- if fsp<>nil then if withfile in fsp^.sflag then errasp(err);
- subeq:
- checkbnds(fsp);
- li:
- begin opconvert(ts); checkasp(fsp,err) end;
- il,rl,lr,ir:
- opconvert(ts);
- es:
- expandnullset(fsp);
- noteq,ri,se:
- errasp(err);
- end
-end;
-
-procedure force(fsp:sp; err:integer);
-begin load; checkasp(fsp,err) end;
-
-function newident(kl:idclass; idt:sp; nxt:ip; err:integer):ip;
-begin newident:=nil;
- if sy<>ident then error(err) else
- begin newident:=newip(kl,id,idt,nxt); insym end
-end;
-
-function stringstruct:sp;
-var lsp:sp;
-begin {only used when ix and zerostring are still valid}
- if zerostring then lsp:=zeroptr else
- begin lsp:=newsp(arrays,ix*sz_char); lsp^.sflag:=[spack];
- lsp^.aeltype:=charptr; lsp^.inxtype:=nil;
- end;
- stringstruct:=lsp;
-end;
-
-function posaddr(var lb:integer; fsp:sp; partword:boolean):integer;
-var sz:integer;
-begin sz:=sizeof(fsp,partword);
- if lb >= MI2-sz then begin error(+016); lb:=0 end;
- if not partword or (sz>=sz_word) then
- while lb mod sz_word <> 0 do lb:=lb+1;
- posaddr:=lb;
- lb:=lb+sz
-end;
-
-function negaddr(fsp:sp):integer;
-var sz:integer;
-begin with b do begin
- sz:=sizeof(fsp,wordmult);
- if reglb <= -MI2+sz then begin error(+017); reglb:=0 end;
- reglb:=reglb-sz;
- while reglb mod sz_word <> 0 do reglb:=reglb-1;
- if reglb < minlb then minlb:=reglb;
- negaddr:=reglb
-end end;
-
-procedure temporary(fsp:sp;r:integer);
-begin inita(fsp,negaddr(fsp));
- if r>=0 then genreg(sizeof(fsp,wordmult),a.pos.ad,r)
-end;
-
-procedure genhol;
-begin gencst(ps_hol,posaddr(holeb,nil,false));
- argcst(-MI2-1); argcst(0); level:=1
-end;
-
-function arraysize(fsp:sp; pack:boolean):integer;
-var sz,min,max,tot,n:integer;
-begin sz:=sizeof(fsp^.aeltype,pack);
- bounds(fsp^.inxtype,min,max);
- fsp^.arpos.lv:=0; fsp^.arpos.ad:=newdlb;
- gencst(ps_rom,min); argcst(max-min); argcst(sz); argend;
- n:=max-min+1; tot:=sz*n;
- if sz<>0 then if tot div sz <> n then begin error(+018); tot:=0 end;
- arraysize:=tot
-end;
-
-procedure treewalk(fip:ip);
-var lsp:sp; i,sz:integer;
-begin
- if fip<>nil then
- begin treewalk(fip^.llink); treewalk(fip^.rlink);
- if fip^.klass=vars then
- begin if not (used in fip^.iflag) then errid(-(+019),fip^.name);
- if not (assigned in fip^.iflag) then errid(-(+020),fip^.name);
- lsp:=fip^.idtype;
- if level<>1 then if not (noreg in fip^.iflag) then
- if (refer in fip^.iflag) or formof(lsp,[pointer]) then
- genreg(sz_addr,fip^.vpos.ad,reg_pointer)
- else
- begin sz:=sizeof(lsp,wordmult);
- if loopvar in fip^.iflag then
- genreg(sz,fip^.vpos.ad,reg_loop)
- else if lsp=realptr then
- genreg(sz,fip^.vpos.ad,reg_float)
- else
- genreg(sz,fip^.vpos.ad,reg_any);
- end;
- if lsp<>nil then if withfile in lsp^.sflag then
- if lsp^.form=files then
- if level=1 then
- begin
- for i:=2 to argc do with argv[i] do
- if name=fip^.name then ad:=fip^.vpos.ad
- end
- else
- begin
- if not (refer in fip^.iflag) then
- begin gencst(op_lal,fip^.vpos.ad); gensp(CLS,sz_addr)
- end
- end
- else
- if level<>1 then errid(-(+021),fip^.name)
- end
- end
-end;
-
-procedure constant(fsys:sos; var fsp:sp; var fval:integer);
-var signed,min:boolean; lip:ip;
-begin signed:=(sy=plussy) or (sy=minsy);
- if signed then begin min:=sy=minsy; insym end else min:=false;
- if find1([ident..stringcst],fsys,+022) then
- begin fval:=val;
- case sy of
- stringcst: fsp:=stringstruct;
- charcst: fsp:=charptr;
- intcst: fsp:=intptr;
- realcst: fsp:=realptr;
- longcst: fsp:=longptr;
- ident:
- begin lip:=searchid([konst]);
- fsp:=lip^.idtype; fval:=lip^.value;
- end
- end; {case}
- if signed then
- if (fsp<>intptr) and (fsp<>realptr) and (fsp<>longptr) then
- error(+023)
- else if min then fval:= -fval;
- {note: negating the v-number for reals and longs}
- insym;
- end
- else begin fsp:=nil; fval:=0 end;
-end;
-
-function cstinteger(fsys:sos; fsp:sp; err:integer):integer;
-var lsp:sp; lval,min,max:integer;
-begin constant(fsys,lsp,lval);
- if fsp<>lsp then
- if not eqstruct(desub(fsp),lsp) then
- begin error(err); lval:=0 end
- else if bounded(fsp) then
- begin bounds(fsp,min,max);
- if (lval<min) or (lval>max) then error(+024)
- end;
- cstinteger:=lval
-end;
-
-{===================================================================}
-
-function typid(err:integer):sp;
-var lip:ip; lsp:sp;
-begin lsp:=nil;
- if sy<>ident then error(err) else
- begin lip:=searchid([types]); lsp:=lip^.idtype; insym end;
- typid:=lsp
-end;
-
-function simpletyp(fsys:sos):sp;
-var lsp,lsp1:sp; lip,hip:ip; min,max:integer; lnp:np;
- newsubrange:boolean;
-begin lsp:=nil;
- if find1([ident..lparent],fsys,+025) then
- if sy=lparent then
- begin insym; lnp:=top; {decl. consts local to innermost block}
- while top^.occur<>blck do top:=top^.nlink;
- lsp:=newsp(scalar,sz_word); hip:=nil; max:=0;
- repeat lip:=newident(konst,lsp,hip,+026);
- if lip<>nil then
- begin enterid(lip); hip:=lip; lip^.value:=max; max:=max+1 end;
- until endofloop(fsys+[rparent],[ident],comma,+027); {+028}
- if max<=MU1 then lsp^.size:=sz_byte;
- lsp^.fconst:=hip; top:=lnp; nextif(rparent,+029);
- end
- else
- begin newsubrange:=true;
- if sy=ident then
- begin lip:=searchid([types,konst]); insym;
- if lip^.klass=types then
- begin lsp:=lip^.idtype; newsubrange:=false end
- else
- begin lsp1:=lip^.idtype; min:=lip^.value end
- end
- else constant(fsys+[colon2,ident..plussy],lsp1,min);
- if newsubrange then
- begin lsp:=newsp(subrange,sz_word); lsp^.subrno:=0;
- if not nicescalar(lsp1) then
- begin error(+030); lsp1:=nil; min:=0 end;
- lsp^.rangetype:=lsp1;
- nextif(colon2,+031); max:=cstinteger(fsys,lsp1,+032);
- if min>max then begin error(+033); max:=min end;
- if (min>=0) and (max<=MU1) then lsp^.size:=sz_byte;
- lsp^.min:=min; lsp^.max:=max
- end
- end;
- simpletyp:=lsp
-end;
-
-function arraytyp(fsys:sos;
- artyp:structform;
- sflag:sflagset;
- function element(fsys:sos):sp
- ):sp;
-var lsp,lsp1,hsp:sp; ok:boolean; sepsy:symbol; lip:ip;
- oksys:sos;
-begin insym; nextif(lbrack,+034); hsp:=nil;
- repeat lsp:=newsp(artyp,0); initpos(lsp^.arpos);
- lsp^.aeltype:=hsp; hsp:=lsp; {link reversed}
- if artyp=carray then
- begin sepsy:=semicolon; oksys:=[ident];
- lip:=newident(carrbnd,lsp,nil,+035); if lip<>nil then enterid(lip);
- nextif(colon2,+036);
- lip:=newident(carrbnd,lsp,lip,+037); if lip<>nil then enterid(lip);
- nextif(colon1,+038); lsp1:=typid(+039);
- ok:=nicescalar(desub(lsp1));
- end
- else
- begin sepsy:=comma; oksys:=[ident..lparent];
- lsp1:=simpletyp(fsys+[comma,rbrack,ofsy,ident..packedsy]);
- ok:=bounded(lsp1)
- end;
- if not ok then begin error(+040); lsp1:=nil end;
- lsp^.inxtype:=lsp1
- until endofloop(fsys+[rbrack,ofsy,ident..packedsy],oksys,
- sepsy,+041); {+042}
- nextif(rbrack,+043); nextif(ofsy,+044);
- lsp:=element(fsys);
- if lsp<>nil then sflag:=sflag + lsp^.sflag * [withfile];
- repeat {reverse links and compute size}
- lsp1:=hsp^.aeltype; hsp^.aeltype:=lsp; hsp^.sflag:=sflag;
- if artyp=arrays then hsp^.size:=arraysize(hsp,spack in sflag);
- lsp:=hsp; hsp:=lsp1
- until hsp=nil; {lsp points to array with highest dimension}
- arraytyp:=lsp
-end;
-
-function typ(fsys:sos):sp;
-var lsp,lsp1:sp; off,sz,min,errno:integer;
- sflag:sflagset; lnp:np;
-
-function fldlist(fsys:sos):sp;
- {level 2: << typ}
-var fip,hip,lip:ip; lsp:sp;
-
-function varpart(fsys:sos):sp;
- {level 3: << fldlist << typ}
-var tip,lip:ip; lsp,headsp,hsp,vsp,tsp,tsp1,tfsp:sp;
- minoff,maxoff,int,nvar:integer; lid:idarr;
-begin insym; tip:=nil; lip:=nil;
- tsp:=newsp(tag,0);
- if sy<>ident then error(+045) else
- begin lid:=id; insym;
- if sy=colon1 then
- begin tip:=newip(field,lid,nil,nil); enterid(tip); insym;
- if sy<>ident then error(+046) else
- begin lid:=id; insym end;
- end;
- if sy=ofsy then {otherwise you may destroy id}
- begin id:=lid; lip:=searchid([types]) end;
- end;
- if lip=nil then tfsp:=nil else tfsp:=lip^.idtype;
- if bounded(tfsp) then
- begin bounds(tfsp,int,nvar); nvar:=nvar-int+1 end
- else
- begin nvar:=0; if tfsp<>nil then begin error(+047); tfsp:=nil end end;
- tsp^.tfldsp:=tfsp;
- if tip<>nil then {explicit tag}
- begin tip^.idtype:=tfsp;
- tip^.foffset:=posaddr(off,tfsp,spack in sflag)
- end;
- nextif(ofsy,+048); minoff:=off; maxoff:=minoff; headsp:=nil;
- repeat hsp:=nil; {for each caselabel list}
- repeat nvar:=nvar-1;
- int:=cstinteger(fsys+[ident..plussy,comma,colon1,lparent,
- semicolon,casesy,rparent],tfsp,+049);
- lsp:=headsp; {each label may occur only once}
- while lsp<>nil do
- begin if lsp^.varval=int then error(+050);
- lsp:=lsp^.nxtvar
- end;
- vsp:=newsp(variant,0); vsp^.varval:=int;
- vsp^.nxtvar:=headsp; headsp:=vsp; {chain of case labels}
- vsp^.subtsp:=hsp; hsp:=vsp;
- {use this field to link labels with same variant}
- until endofloop(fsys+[colon1,lparent,semicolon,casesy,rparent],
- [ident..plussy],comma,+051); {+052}
- nextif(colon1,+053); nextif(lparent,+054);
- tsp1:=fldlist(fsys+[rparent,semicolon,ident..plussy]);
- if off>maxoff then maxoff:=off;
- while vsp<>nil do
- begin vsp^.size:=off; hsp:=vsp^.subtsp;
- vsp^.subtsp:=tsp1; vsp:=hsp
- end;
- nextif(rparent,+055);
- off:=minoff;
- until lastsemicolon(fsys,[ident..plussy],+056); {+057 +058}
- if nvar>0 then error(-(+059));
- tsp^.fstvar:=headsp; tsp^.size:=minoff; off:=maxoff; varpart:=tsp;
-end;
-
-begin {fldlist}
- if find2([ident],fsys+[casesy],+060) then
- repeat lip:=nil; hip:=nil;
- repeat fip:=newident(field,nil,nil,+061);
- if fip<>nil then
- begin enterid(fip);
- if lip=nil then hip:=fip else lip^.next:=fip; lip:=fip;
- end;
- until endofloop(fsys+[colon1,ident..packedsy,semicolon,casesy],
- [ident],comma,+062); {+063}
- nextif(colon1,+064);
- lsp:=typ(fsys+[casesy,semicolon]);
- if lsp<>nil then if withfile in lsp^.sflag then
- sflag:=sflag+[withfile];
- while hip<>nil do
- begin hip^.idtype:=lsp;
- hip^.foffset:=posaddr(off,lsp,spack in sflag);
- hip:=hip^.next
- end;
- until lastsemicolon(fsys+[casesy],[ident],+065); {+066 +067}
- if sy=casesy then fldlist:=varpart(fsys) else fldlist:=nil;
-end;
-
-
-begin {typ}
- sflag:=[]; lsp:=nil;
- if sy=packedsy then begin sflag:=[spack]; insym end;
- if find1([ident..filesy],fsys,+068) then
- if sy in [ident..arrow] then
- begin if spack in sflag then error(+069);
- if sy=arrow then
- begin lsp:=newsp(pointer,sz_addr); insym;
- if not intypedec then lsp^.eltype:=typid(+070) else
- if sy<>ident then error(+071) else
- begin fwptr:=newip(types,id,lsp,fwptr); insym end
- end
- else lsp:=simpletyp(fsys);
- end
- else
- case sy of
-{<<<<<<<<<<<<}
-arraysy:
- lsp:=arraytyp(fsys,arrays,sflag,typ);
-recordsy:
- begin insym;
- new(lnp,rec); lnp^.occur:=rec; lnp^.nlink:=top; lnp^.fname:=nil; top:=lnp;
- off:=0; lsp1:=fldlist(fsys+[endsy]); {fldlist updates off}
- lsp:=newsp(records,off); lsp^.tagsp:=lsp1;
- lsp^.fstfld:=top^.fname; lsp^.sflag:=sflag;
- top:=top^.nlink; nextif(endsy,+072)
- end;
-setsy:
- begin insym; nextif(ofsy,+073);
- lsp:=simpletyp(fsys); lsp1:=desub(lsp); errno:=0;
- if bounded(lsp1) then
- begin bounds(lsp1,min,sz);
- if sz div NB1>=sz_mset then errno:=+074
- end
- else if bounded(lsp) then {subrange of integer}
- begin bounds(lsp,min,sz);
- if (min<0) or (sz>=iopt) then errno:=+075;
- sz:=iopt-1
- end
- else if lsp=intptr then
- begin sz:=iopt-1; errno:=-(+076) end
- else
- errno:=+077;
- if errno<>0 then
- begin error(errno); if errno>0 then begin lsp1:=nil; sz:=0 end end;
- lsp:=newsp(power,sz div NB1 +1); lsp^.elset:=lsp1;
- end;
-filesy:
- begin insym; nextif(ofsy,+078); lsp1:=typ(fsys);
- if lsp1<>nil then if withfile in lsp1^.sflag then error(-(+079));
- sz:=sizeof(lsp1,wordpart); if sz<sz_buff then sz:=sz_buff;
- lsp:=newsp(files,sz+sz_head); lsp^.filtype:=lsp1;
- end;
-{>>>>>>>>>>>>}
- end; {case}
- typ:=lsp;
-end;
-
-function vpartyp(fsys:sos):sp;
-begin
- if find2([arraysy],fsys+[ident],+080) then
- vpartyp:=arraytyp(fsys,carray,[],vpartyp)
- else
- vpartyp:=typid(+081)
-end;
-
-{===================================================================}
-
-procedure block(fsys:sos; fip:ip); forward;
- {pfdeclaration calls block. With a more obscure lexical
- structure this forward declaration can be avoided}
-
-procedure labeldeclaration(fsys:sos);
-var llp:lp;
-begin with b do begin
- repeat
- if sy<>intcst then error(+082) else
- begin
- if searchlab(lchain,val)<>nil then errint(+083,val) else
- begin new(llp); llp^.labval:=val;
- if val>9999 then teststandard;
- ilbno:=ilbno+1; llp^.labname:=ilbno; llp^.labdlb:=0;
- llp^.seen:=false; llp^.nextlp:=lchain; lchain:=llp;
- end;
- insym
- end
- until endofloop(fsys+[semicolon],[intcst],comma,+084); {+085}
- nextif(semicolon,+086)
-end end;
-
-procedure constdefinition(fsys:sos);
-var lip:ip;
-begin
- repeat lip:=newident(konst,nil,nil,+087);
- if lip<>nil then
- begin nextif(eqsy,+088);
- constant(fsys+[semicolon,ident],lip^.idtype,lip^.value);
- nextif(semicolon,+089); enterid(lip);
- end;
- until not find2([ident],fsys,+090);
-end;
-
-procedure typedefinition(fsys:sos);
-var lip:ip;
-begin fwptr:=nil; intypedec:=true;
- repeat lip:=newident(types,nil,nil,+091);
- if lip<>nil then
- begin nextif(eqsy,+092);
- lip^.idtype:=typ(fsys+[semicolon,ident]);
- nextif(semicolon,+093); enterid(lip);
- end;
- until not find2([ident],fsys,+094);
- while fwptr<>nil do
- begin assert sy<>ident;
- id:=fwptr^.name; lip:=searchid([types]);
- fwptr^.idtype^.eltype:=lip^.idtype; fwptr:=fwptr^.next
- end;
- intypedec:=false;
-end;
-
-procedure vardeclaration(fsys:sos);
-var lip,hip,vip:ip; lsp:sp;
-begin with b do begin
- repeat hip:=nil; lip:=nil;
- repeat vip:=newident(vars,nil,nil,+095);
- if vip<>nil then
- begin enterid(vip); vip^.iflag:=[];
- if lip=nil then hip:=vip else lip^.next:=vip; lip:=vip;
- end;
- until endofloop(fsys+[colon1,ident..packedsy],[ident],comma,+096); {+097}
- nextif(colon1,+098);
- lsp:=typ(fsys+[semicolon,ident]);
- while hip<>nil do
- begin hip^.idtype:=lsp;
- if level<=1 then
- hip^.vpos.ad:=posaddr(holeb,lsp,false)
- else
- hip^.vpos.ad:=negaddr(lsp);
- hip:=hip^.next
- end;
- nextif(semicolon,+099);
- until not find2([ident],fsys,+0100);
-end end;
-
-procedure pfhead(fsys:sos;var fip:ip;var again:boolean;param:boolean);
- forward;
-
-procedure parlist(fsys:sos; slink:boolean; var tip:ip; var maxlb:integer);
-var lastip,hip,lip,pip:ip; lsp,tsp:sp; iflag:iflagset; again:boolean;
-begin tip:=nil; lastip:=nil;
- maxlb:=0; if slink then maxlb:=sz_addr;
- repeat {once for each formal-parameter-section}
- if find1([ident,varsy,procsy,funcsy],fsys+[semicolon],+0101) then
- begin
- if (sy=procsy) or (sy=funcsy) then
- begin
- pfhead(fsys+[semicolon,ident,varsy,procsy,funcsy],hip,again,true);
- hip^.pfpos.ad:=posaddr(maxlb,procptr,false);
- hip^.pfkind:=formal; lip:=hip;
- top:=top^.nlink; level:=level-1
- end
- else
- begin hip:=nil; lip:=nil; iflag:=[assigned];
- if sy=varsy then
- begin iflag:=[refer,assigned,used]; insym end;
- repeat pip:=newident(vars,nil,nil,+0102);
- if pip<>nil then
- begin enterid(pip); pip^.iflag:=iflag;
- if lip=nil then hip:=pip else lip^.next:=pip; lip:=pip;
- end;
- iflag:=iflag+[samesect];
- until endofloop(fsys+[semicolon,colon1],[ident],comma,+0103);
- {+0104}
- nextif(colon1,+0105);
- if refer in iflag then
- begin lsp:=vpartyp(fsys+[semicolon]); tsp:=lsp;
- while formof(tsp,[carray]) do
- begin tsp^.arpos.ad:=posaddr(maxlb,nilptr,false);
- tsp:=tsp^.aeltype
- end;
- tsp:=nilptr;
- end
- else
- begin lsp:=typid(+0106); tsp:=lsp end;
- pip:=hip;
- while pip<>nil do
- begin pip^.vpos.ad:=posaddr(maxlb,tsp,false); pip^.idtype:=lsp;
- pip:=pip^.next
- end;
- end;
- if lastip=nil then tip:=hip else lastip^.next:=hip; lastip:=lip;
- end;
- until endofloop(fsys,[ident,varsy,procsy,funcsy],semicolon,+0107); {+0108}
-end;
-
-procedure pfhead; {forward declared}
-var lip:ip; lsp:sp; lnp:np; kl:idclass;
-begin lip:=nil; again:=false;
- if sy=procsy then kl:=proc else
- begin kl:=func; fsys:=fsys+[colon1,ident] end;
- insym;
- if sy<>ident then begin error(+0109); id:=spaces end;
- if not param then lip:=searchsection(top^.fname);
- if lip<>nil then
- if (lip^.klass<>kl) or (lip^.pfkind<>forward) then errid(+0110,id) else
- begin b.forwcount:=b.forwcount-1; again:=true end;
- if again then insym else
- begin lip:=newip(kl,id,nil,nil);
- if sy=ident then begin enterid(lip); insym end;
- lastpfno:=lastpfno+1; lip^.pfno:=lastpfno;
- end;
- level:=level+1;
- new(lnp,blck); lnp^.occur:=blck; lnp^.nlink:=top; top:=lnp;
- if again then lnp^.fname:=lip^.parhead else
- begin lnp^.fname:=nil;
- if find3(lparent,fsys,+0111) then
- begin parlist(fsys+[rparent],lip^.pfpos.lv>1,lip^.parhead,lip^.maxlb);
- nextif(rparent,+0112)
- end;
- end;
- if (kl=func) and not again then
- begin nextif(colon1,+0113); lsp:=typid(+0114);
- if formof(lsp,[power..tag]) then
- begin error(+0115); lsp:=nil end;
- lip^.idtype:=lsp;
- end;
- fip:=lip;
-end;
-
-procedure pfdeclaration(fsys:sos);
-var lip:ip; again,headonly:boolean; markp:^integer; lbp:bp; kind:kindofpf;
-begin with b do begin
- pfhead(fsys+[ident,semicolon,labelsy..beginsy],lip,again,false);
- nextif(semicolon,+0116);
- if find1([ident,labelsy..beginsy],fsys+[semicolon],+0117) then
- begin headonly:=sy=ident;
- if headonly then
- begin kind:=standard;
- if id='forward ' then kind:=forward else
- if id='extern ' then kind:=extern else
- if id='varargs ' then kind:=varargs else errid(+0118,id);
- if kind<>standard then
- begin insym; lip^.pfkind:=kind;
- if kind=forward then
- if again then errid(+0119,lip^.name) else
- forwcount:=forwcount+1
- else
- begin lip^.pfpos.lv:=1; teststandard end
- end;
- end;
- if not again then
- if lip^.pfpos.lv<=1 then genpnam(ps_exp,lip) else genpnam(ps_inp,lip);
- if not headonly then
- begin lip^.pfkind:=actual;
-#ifndef STANDARD
- mark(markp);
-#endif
- new(lbp); lbp^:=b; nextbp:=lbp;
- reglb:=0; minlb:=0; ilbno:=0; forwcount:=0; lchain:=nil;
- block(fsys+[semicolon],lip);
- b:=nextbp^;
-#ifndef STANDARD
- release(markp);
-#endif
- end;
- end;
- if not main then eofexpected:=forwcount=0;
- nextif(semicolon,+0120);
- level:=level-1; top:=top^.nlink;
-end end;
-
-{===================================================================}
-
-procedure expression(fsys:sos); forward;
- {this forward declaration cannot be avoided}
-
-procedure selectarrayelement(fsys:sos);
-var isp,lsp:sp;
-begin
- repeat loadaddr; isp:=nil;
- if formof(a.asp,[arrays,carray]) then isp:=a.asp^.inxtype else
- errasp(+0121);
- lsp:=a.asp;
- expression(fsys+[comma]); force(desub(isp),+0122);
- {no range check}
- if lsp<>nil then
- begin a.packbit:=spack in lsp^.sflag;
- descraddr(lsp^.arpos); lsp:=lsp^.aeltype
- end;
- a.asp:=lsp; a.ak:=indexed;
- until endofloop(fsys,[notsy..lparent],comma,+0123); {+0124}
-end;
-
-procedure selector(fsys: sos; fip:ip; iflag:iflagset);
-{selector computes the address of any kind of variable.
- Four possibilities:
- 1.for direct accessable variables (fixed), a contains offset and level,
- 2.for indirect accessable variables (ploaded), the address is on the stack.
- 3.for array elements, the top of stack gives the index (one word).
- The address of the array is beneath it.
- 4.for variables with address in direct accessible pointer variable (pfixed),
- the offset and level of the pointer is stored in a.
- If a.asp=nil then an error occurred else a.asp gives
- the type of the variable.
-}
-var lip:ip;
-begin inita(fip^.idtype,0);
- case fip^.klass of
- vars: with a do
- begin pos:=fip^.vpos; if refer in fip^.iflag then ak:=pfixed end;
- field:
- begin a:=lastnp^.wa; fieldaddr(fip^.foffset); a.asp:=fip^.idtype end;
- func: with a do
- if fip^.pfkind=standard then errasp(+0125) else
- if (fip^.pfpos.lv>=level-1) and (fip<>currproc) then error(+0126) else
- if fip^.pfkind<>actual then error(+0127) else
- begin pos:=fip^.pfpos; pos.lv:=pos.lv+1;
- if sy=arrow then error(+0128);
- end
- end; {case}
- if (sy=lbrack) or (sy=period) then iflag:=iflag+[noreg];
- while find2([lbrack,period,arrow],fsys,+0129) do with a do
- if sy=lbrack then
- begin insym; selectarrayelement(fsys+[rbrack,lbrack,period,arrow]);
- nextif(rbrack,+0130);
- end else
- if sy=period then
- begin insym;
- if sy<>ident then error(+0131) else
- begin
- if not formof(asp,[records]) then errasp(+0132) else
- begin lip:=searchsection(asp^.fstfld);
- if lip=nil then begin errid(+0133,id); asp:=nil end else
- begin packbit:=spack in asp^.sflag;
- fieldaddr(lip^.foffset); asp:=lip^.idtype
- end
- end;
- insym
- end
- end
- else
- begin insym; iflag:=[used];
- if asp<>nil then
- if asp=zeroptr then errasp(+0134) else
- if asp^.form=pointer then
- begin
- if ak=fixed then ak:=pfixed else
- begin load; ak:=ploaded end;
- asp:=asp^.eltype
- end else
- if asp^.form=files then
- begin loadaddr; gensp(WDW,sz_addr); gencst(op_lfr,sz_addr);
- asp:=asp^.filtype; ak:=ploaded; packbit:=true;
- end
- else errasp(+0135);
- end;
- fip^.iflag:=fip^.iflag+iflag;
-end;
-
-procedure variable(fsys:sos);
-var lip: ip;
-begin
- if sy=ident then
- begin lip:=searchid([vars,field]); insym;
- selector(fsys,lip,[used,assigned,noreg])
- end
- else begin error(+0136); inita(nil,0) end;
-end;
-
-{===================================================================}
-
-function plistequal(p1,p2:ip):boolean;
-var ok:boolean; q1,q2:sp;
-begin plistequal:=eqstruct(p1^.idtype,p2^.idtype);
- p1:=p1^.parhead; p2:=p2^.parhead;
- while (p1<>nil) and (p2<>nil) do
- begin ok:=false;
- if p1^.klass=p2^.klass then
- if p1^.klass<>vars then ok:=plistequal(p1,p2) else
- begin q1:=p1^.idtype; q2:=p2^.idtype; ok:=true;
- while ok and formof(q1,[carray]) and formof(q2,[carray]) do
- begin ok:=eqstruct(q1^.inxtype,q2^.inxtype);
- q1:=q1^.aeltype; q2:=q2^.aeltype;
- end;
- if not (eqstruct(q1,q2) and
- (p1^.iflag*[refer,samesect] = p2^.iflag*[refer,samesect]))
- then ok:=false;
- end;
- if not ok then plistequal:=false;
- p1:=p1^.next; p2:=p2^.next
- end;
- if (p1<>nil) or (p2<>nil) then plistequal:=false
-end;
-
-procedure callnonstandard(fsys:sos; moreargs:boolean; fip:ip);
-var nxt,lip:ip; l0,l1,l2,l3,sz:integer; lsp,savasp:sp;
-begin with a do begin
- l0:=lino; sz:=0; nxt:=fip^.parhead;
- while moreargs do
- begin l1:=lino;
- if nxt=nil then
- begin if fip^.pfkind<>varargs then error(+0137);
- expression(fsys); load; sz:=sz+sizeof(asp,wordmult)
- end
- else
- begin lsp:=nxt^.idtype;
- if nxt^.klass<>vars then {proc or func}
- begin inita(procptr,0); sz:=sz+sz_proc;
- if sy<>ident then error(+0138) else
- begin lip:=searchid([nxt^.klass]); insym;
- if lip^.pfkind=standard then error(+0139) else
- if not plistequal(nxt,lip) then error(+0140)
- else
- begin pos:=lip^.pfpos;
- if lip^.pfkind=formal then load else
- begin
- if lip^.pfpos.lv<=1 then gencst(op_zer,sz_addr) else
- gencst(op_lxl,level-lip^.pfpos.lv);
- genpnam(op_lpi,lip)
- end
- end
- end
- end
- else if not (refer in nxt^.iflag) then {call by value}
- begin expression(fsys); force(lsp,+0141);
- sz:=sz+sizeof(asp,wordmult);
- end
- else {call by reference}
- begin variable(fsys); loadaddr; sz:=sz+sz_addr;
- if samesect in nxt^.iflag then lsp:=savasp else
- begin savasp:=asp; l2:=lino;
- while formof(lsp,[carray])
- and formof(asp,[arrays,carray]) do
- if (compat(lsp^.inxtype,asp^.inxtype) > subeq) or
- (lsp^.sflag<>asp^.sflag) then errasp(+0142) else
- begin l3:=lino; descraddr(asp^.arpos); exchange(l2,l3);
- sz:=sz+sz_addr; asp:=asp^.aeltype; lsp:=lsp^.aeltype
- end
- end;
- if not eqstruct(asp,lsp) then errasp(+0143);
- if packbit then errasp(+0144);
- end;
- nxt:=nxt^.next
- end;
- exchange(l0,l1); moreargs:=find3(comma,fsys,+0145)
- end;
- if nxt<>nil then error(+0146);
- inita(procptr,0); pos:=fip^.pfpos;
- if fip^.pfkind=formal then
- with b do
- begin load; ilbno:=ilbno+2;
- gencst(op_exg,sz_addr);
- gencst(op_dup,sz_addr);
- gencst(op_zer,sz_addr);
- genop(op_cmp);
- gencst(op_zeq,ilbno-1);
- gencst(op_exg,sz_addr);
- genop(op_cai);
- gencst(op_asp,sz_addr);
- gencst(op_bra,ilbno);
- newilb(ilbno-1);
- gencst(op_asp,sz_addr);
- genop(op_cai);
- newilb(ilbno);
- end
- else
- begin
- if pos.lv>1 then
- begin gencst(op_lxl,level-pos.lv); sz:=sz+sz_addr end;
- genpnam(op_cal,fip)
- end;
- if sz<>0 then gencst(op_asp,sz);
- asp:=fip^.idtype;
- if asp<>nil then genasp(op_lfr)
-end end;
-
-procedure fileaddr;
-var la:attr;
-begin la:=a; a:=fa; loadaddr; a:=la end;
-
-procedure callr(l1,l2:integer);
-var la:attr; m:libmnem;
-begin with a do begin
- la:=a; asp:=desub(asp); fileaddr; m:=RDI;
- if asp<>intptr then
- if asp=charptr then m:=RDC else
- if asp=realptr then m:=RDR else
- if asp=longptr then m:=RDL else errasp(+0147);
- gensp(m,sz_addr); genasp(op_lfr);
- if asp<>la.asp then checkbnds(la.asp);
- a:=la; exchange(l1,l2); store;
-end end;
-
-procedure callw(fsys:sos; l1,l2:integer);
-var m:libmnem; s:integer;
-begin with a do begin
- fileaddr; exchange(l1,l2); loadcheap; asp:=desub(asp);
- if string(asp) then
- begin gencst(op_loc,asp^.size); m:=WRS; s:=sz_addr+sz_word end
- else
- begin m:=WRI; s:=sizeof(asp,wordmult);
- if asp<>intptr then
- if asp=charptr then m:=WRC else
- if asp=realptr then m:=WRR else
- if asp=boolptr then m:=WRB else
- if asp=zeroptr then m:=WRZ else
- if asp=longptr then m:=WRL else errasp(+0148);
- end;
- if find3(colon1,fsys,+0149) then
- begin expression(fsys+[colon1]); force(intptr,+0150);
- m:=succ(m); s:=s+sz_int
- end;
- if find3(colon1,fsys,+0151) then
- begin expression(fsys); force(intptr,+0152); s:=s+sz_int;
- if m<>WSR then error(+0153) else m:=WRF;
- end;
- gensp(m,s+sz_addr);
-end end;
-
-procedure callrw(fsys:sos; lpar,w,ln:boolean);
-var l1,l2,errno:integer; ftype,lsp,fsp:sp; savlb:integer; m:libmnem;
-begin with b do begin savlb:=reglb; ftype:=textptr;
- inita(textptr,argv[ord(w)].ad); a.pos.lv:=0; fa:=a;
- if lpar then
- begin l1:=lino; if w then expression(fsys+[colon1]) else variable(fsys);
- l2:=lino;
- if formof(a.asp,[files]) then
- begin ftype:=a.asp;
- if (a.ak<>fixed) and (a.ak<>pfixed) then
- begin loadaddr; temporary(nilptr,reg_pointer);
- store; a.ak:=pfixed
- end;
- fa:=a; {store doesn't change a}
- if (sy<>comma) and not ln then error(+0154);
- end
- else
- begin if iop[w]=nil then error(+0155);
- if w then callw(fsys,l1,l2) else callr(l1,l2)
- end;
- while find3(comma,fsys,+0156) do with a do
- begin l1:=lino;
- if w then expression(fsys+[colon1]) else variable(fsys);
- l2:=lino;
- if ftype=textptr then
- if w then callw(fsys,l1,l2) else callr(l1,l2)
- else
- begin errno:=+0157; fsp:=ftype^.filtype;
- if w then force(fsp,errno) else
- begin store; lsp:=asp; l2:=lino end;
- fileaddr; gensp(WDW,sz_addr); gencst(op_lfr,sz_addr);
- ak:=ploaded; packbit:=true; asp:=fsp;
- if w then store else
- begin force(lsp,errno); exchange(l1,l2) end;
- fileaddr; if w then m:=PUTX else m:=GETX; gensp(m,sz_addr)
- end
- end;
- end
- else
- if not ln then error(+0158) else
- if iop[w]=nil then error(+0159);
- if ln then
- begin if ftype<>textptr then error(+0160);
- fileaddr; if w then m:=WLN else m:=RLN; gensp(m,sz_addr)
- end;
- reglb:=savlb
-end end;
-
-procedure callnd(fsys:sos);
-label 1;
-var lsp:sp; int:integer;
-begin with a do begin
- if asp=zeroptr then errasp(+0161) else asp:=asp^.eltype;
- while find3(comma,fsys,+0162) do
- begin
- if asp<>nil then {asp of form record or variant}
- if asp^.form=records then asp:=asp^.tagsp else
- if asp^.form=variant then asp:=asp^.subtsp else errasp(+0163);
- if asp=nil then constant(fsys,lsp,int) else
- begin assert asp^.form=tag;
- int:=cstinteger(fsys,asp^.tfldsp,+0164); lsp:=asp^.fstvar;
- while lsp<>nil do
- if lsp^.varval<>int then lsp:=lsp^.nxtvar else
- begin asp:=lsp; goto 1 end;
- end;
-1: end;
- genasp(op_loc)
-end end;
-
-procedure call(fsys: sos; fip: ip);
-var lkey: standpf; lpar:boolean; lsp,sp1,sp2:sp;
- m:libmnem; s:integer; b:byte;
-begin with a do begin fsys:=fsys+[comma];
- lpar:=find3(lparent,fsys,+0165); if lpar then fsys:=fsys+[rparent];
- if fip^.pfkind<>standard then callnonstandard(fsys,lpar,fip) else
- begin lkey:=fip^.key; m:=CLS; lsp:=nil;
- if not lpar then
- if lkey in [pput..prelease,fabs..fatn] then error(+0166);
- if lkey in [pput..ppage,feof,feoln] then
- begin s:=sz_addr;
- if lpar then
- begin variable(fsys); loadaddr end
- else
- begin asp:=textptr;
- if iop[lkey=ppage]=nil then errasp(+0167) else
- gencst(op_lae,argv[ord(lkey=ppage)].ad)
- end;
- if lkey in [pput..prewrite,ppage,feof,feoln] then
- if not formof(asp,[files]) then
- begin error(+0168); asp:=textptr end;
- if lkey in [pnew,pdispose,pmark,prelease] then
- if not formof(asp,[pointer]) then
- begin error(+0169); asp:=nilptr end;
- end;
- case lkey of
- pread, preadln, pwrite, pwriteln: {0,1,2,3 resp}
- callrw(fsys,lpar,lkey>=pwrite,odd(ord(lkey)));
- pput: m:=PUTX;
- pget: m:=GETX;
- ppage: m:=PAG;
- preset: m:=OPN;
- prewrite: m:=CRE;
- pnew: m:=NEWX;
- pdispose: m:=DIS;
- ppack:
- begin sp2:=asp; nextif(comma,+0170); expression(fsys); load;
- lsp:=asp; nextif(comma,+0171); variable(fsys); loadaddr;
- sp1:=asp; asp:=lsp; m:=PAC
- end;
- punpack:
- begin sp1:=asp; nextif(comma,+0172); variable(fsys); loadaddr;
- sp2:=asp; nextif(comma,+0173); expression(fsys); load;
- m:=UNP
- end;
- pmark: m:=SAV;
- prelease: m:=RST;
- phalt:
- begin m:=HLT; teststandard;
- if lpar then lsp:=intptr else gencst(op_loc,0);
- end;
- feof: m:=EFL;
- feoln: m:=ELN;
- fodd, fchr: lsp:=intptr;
- fpred: b:=op_dec;
- fsucc: b:=op_inc;
- fround: m:=RND;
- fsin, fcos, fexp, fsqt, flog, fatn: lsp:=realptr;
- fabs, fsqr, ford, ftrunc: ;
- end;
- if lpar then if lkey in [phalt,fabs..fatn] then
- begin expression(fsys);
- force(lsp,+0174); s:=sizeof(asp,wordmult)
- end;
- if lkey in [ppack,punpack,fabs..fodd] then
- asp:=desub(asp);
- case lkey of
- ppage, feoln:
- begin if asp<>textptr then error(+0175); asp:=boolptr end;
- preset, prewrite:
- begin s:=sz_addr+sz_word;
- if asp=textptr then gencst(op_loc,0) else
- gencst(op_loc,sizeof(asp^.filtype,wordpart));
- end;
- pnew, pdispose:
- begin callnd(fsys); s:=sz_addr+sz_word end;
- ppack, punpack:
- begin s:=2*sz_addr+sz_int;
- if formof(sp1,[arrays,carray])
- and formof(sp2,[arrays,carray]) then
- if (spack in (sp1^.sflag - sp2^.sflag)) and
- eqstruct(sp1^.aeltype,sp2^.aeltype) and
- eqstruct(desub(sp1^.inxtype),asp) and
- eqstruct(desub(sp2^.inxtype),asp) then
- begin descraddr(sp1^.arpos); descraddr(sp2^.arpos) end
- else error(+0176)
- else error(+0177)
- end;
- pmark, prelease: teststandard;
- feof: asp:=boolptr;
- fabs:
- if asp=intptr then m:=ABI else
- if asp=longptr then m:=ABL else
- if asp=realptr then m:=ABR else errasp(+0178);
- fsqr:
- begin
- if (asp=intptr) or (asp=longptr) then b:=op_mli else
- if asp=realptr then begin b:=op_mlf; fltused:=true end
- else errasp(+0179);
- genasp(op_dup); genasp(b)
- end;
- ford:
- begin if not nicescalar(asp) then errasp(+0180); asp:=intptr end;
- fchr: checkbnds(charptr);
- fpred, fsucc:
- begin genop(b);
- if nicescalar(asp) then genrck(asp) else errasp(+0181)
- end;
- fodd:
- begin gencst(op_loc,1); asp:=boolptr; genasp(op_and) end;
- ftrunc, fround: if asp<>realptr then errasp(+0182);
- fsin: m:=SINX;
- fcos: m:=COSX;
- fexp: m:=EXPX;
- fsqt: m:=SQT;
- flog: m:=LOG;
- fatn: m:=ATN;
- phalt:s:=0;
- pread, preadln, pwrite, pwriteln, pput, pget: ;
- end;
- if m<>CLS then
- begin gensp(m,s);
- if lkey>=feof then genasp(op_lfr)
- end;
- if (lkey=fround) or (lkey=ftrunc) then
- opconvert(ri);
- end;
- if lpar then nextif(rparent,+0183);
-end end;
-
-{===================================================================}
-
-procedure convert(fsp:sp; l1:integer);
-{Convert tries to make the operands of some operator of the same type.
- The operand types are given by fsp and a.asp. The resulting type
- is put in a.asp.
- l1 gives the lino of the first instruction of the right operand.
-}
-var l2:integer; ts:twostruct; lsp:sp;
-begin with a do begin asp:=desub(asp);
- ts:=compat(asp,fsp);
- case ts of
- eq,subeq:
- ;
- il,ir,lr:
- opconvert(ts);
- es:
- expandnullset(fsp);
- li,ri,rl,se:
- begin l2:=lino; lsp:=asp; asp:=fsp;
- convert(lsp,l1); exchange(l1,l2); asp:=lsp
- end;
- noteq:
- errasp(+0184);
- end;
- if asp=realptr then fltused:=true
-end end;
-
-procedure buildset(fsys:sos);
-{This is a bad construct in pascal. Two objections:
- - expr..expr very difficult to implement on most machines
- - this construct makes it hard to implement sets of different size
-}
-const ncsw = 16; {tunable}
-type wordset = set of 0..MB2;
-var i,j,val1,val2,ncst,l1,l2,sz:integer;
- cst1,cst2,cst12,varpart:boolean;
- cstpart:array[1..ncsw] of wordset;
-
-procedure genwordset(s:wordset);
- {level 2: << buildset}
-var b,i,w:integer;
-begin i:=0; w:=0; b:=-1;
- repeat
- if i in s then w:=w-b; b:=b+b; i:=i+1
- until i=MB2;
- if i in s then w:=w+b;
- gencst(op_loc,w)
-end;
-
-procedure setexpr(fsys:sos; var c:boolean; var v:integer);
- {level 2: << buildset}
-var min:integer; lsp:sp;
-begin with a do begin c:=false; v:=0; lsp:=asp;
- expression(fsys); asp:=desub(asp);
- if not eqstruct(asp,lsp^.elset) then
- begin error(+0185); lsp:=nullset end;
- if lsp=nullset then
- begin
- if bounded(asp) then bounds(asp,min,sz) else
- if asp=intptr then sz:=iopt-1 else begin errasp(+0186); sz:=0 end;
- sz:=sz div NB1 + 1; while sz mod sz_word <> 0 do sz:=sz+1;
- if sz>sz_mset then errasp(+0187);
- lsp:=newsp(power,sz); lsp^.elset:=asp
- end;
- if asp<>nil then if ak=cst then
- if (pos.ad<0) or (pos.ad div NB1>=sizeof(lsp,wordmult)) then
- error(+0188)
- else if sz<=ncsw*sz_word then
- begin c:=true; v:=pos.ad end;
- if not c then load; asp:=lsp
-end end;
-
-begin with a do begin {buildset}
- varpart:=false; ncst:=0; asp:=nullset;
- for i:=1 to ncsw do cstpart[i]:=[];
- if find2([notsy..lparent],fsys,+0189) then
- repeat l1:=lino;
- setexpr(fsys+[colon2,comma],cst1,val1); cst12:=cst1;
- if find3(colon2,fsys+[comma,notsy..lparent],+0190) then
- begin setexpr(fsys+[comma,notsy..lparent],cst2,val2);
- cst12:=cst12 and cst2;
- if not cst12 then
- begin
- if cst2 then gencst(op_loc,val2);
- if cst1 then
- begin l2:=lino; gencst(op_loc,val1); exchange(l1,l2) end;
- l2:=lino; genasp(op_zer); exchange(l1,l2);
- genasp(op_loc); gensp(BTS,3*sz_word)
- end;
- end
- else
- if cst12 then val2:=val1 else genasp(op_set);
- if cst12 then
- for i:=val1 to val2 do
- begin j:=i div NB2 + 1; ncst:=ncst+1;
- cstpart[j]:=cstpart[j] + [i mod NB2]
- end
- else
- if varpart then genasp(op_ior) else varpart:=true;
- until endofloop(fsys,[notsy..lparent],comma,+0191); {+0192}
- ak:=loaded;
- if ncst>0 then
- begin
- for i:=sizeof(asp,wordmult) div sz_word downto 1 do
- genwordset(cstpart[i]);
- if varpart then genasp(op_ior);
- end
- else
- if not varpart then genasp(op_zer); {empty set}
-end end;
-
-procedure factor(fsys: sos);
-var lip:ip; lsp:sp;
-begin with a do begin
- asp:=nil; packbit:=false; ak:=loaded;
- if find1([notsy..nilcst,lparent],fsys,+0193) then
- case sy of
- ident:
- begin lip:=searchid([konst,vars,field,func,carrbnd]); insym;
- case lip^.klass of
- func: {call moves result to top stack}
- begin call(fsys,lip); ak:=loaded; packbit:=false end;
- konst:
- begin asp:=lip^.idtype;
- if nicescalar(asp) then {including asp=nil}
- begin ak:=cst; pos.ad:=lip^.value end
- else
- begin ak:=ploaded; laedlb(abs(lip^.value));
- if asp^.form=scalar then
- begin load; if lip^.value<0 then negate end
- else
- if asp=zeroptr then ak:=loaded
- end
- end;
- field,vars:
- selector(fsys,lip,[used]);
- carrbnd:
- begin lsp:=lip^.idtype; assert formof(lsp,[carray]);
- descraddr(lsp^.arpos); lsp:=lsp^.inxtype; asp:=desub(lsp);
- if lip^.next=nil then ak:=ploaded {low bound} else
- begin gencst(op_loi,2*sz_int); genasp(op_adi) end;
- load; checkbnds(lsp);
- end;
- end {case}
- end;
- intcst:
- begin asp:=intptr; ak:=cst; pos.ad:=val; insym end;
- realcst:
- begin asp:=realptr; ak:=ploaded; laedlb(val); insym end;
- longcst:
- begin asp:=longptr; ak:=ploaded; laedlb(val); insym end;
- charcst:
- begin asp:=charptr; ak:=cst; pos.ad:=val; insym end;
- stringcst:
- begin asp:=stringstruct; laedlb(val); insym;
- if asp<>zeroptr then ak:=ploaded;
- end;
- nilcst:
- begin insym; asp:=nilptr; genasp(op_zer); end;
- lparent:
- begin insym; expression(fsys+[rparent]); nextif(rparent,+0194) end;
- notsy:
- begin insym; factor(fsys); load; genop(op_teq); asp:=desub(asp);
- if asp<>boolptr then errasp(+0195)
- end;
- lbrack:
- begin insym; buildset(fsys+[rbrack]); nextif(rbrack,+0196) end;
- end
-end end;
-
-procedure term(fsys:sos);
-var lsy:symbol; lsp:sp; l1:integer; first:boolean;
-begin with a,b do begin first:=true; l1:=lino;
- factor(fsys+[starsy..andsy]);
- while find2([starsy..andsy],fsys,+0197) do
- begin if first then begin load; first:=false end;
- lsy:=sy; insym; l1:=lino; lsp:=asp;
- factor(fsys+[starsy..andsy]); load; convert(lsp,l1);
- if asp<>nil then
- case lsy of
- starsy:
- if (asp=intptr) or (asp=longptr) then genasp(op_mli) else
- if asp=realptr then genasp(op_mlf) else
- if asp^.form=power then genasp(op_and) else errasp(+0198);
- slashsy:
- begin
- if (asp=intptr) or (asp=longptr) then
- begin lsp:=asp;
- convert(realptr,l1); {make real of right operand}
- convert(lsp,l1); {make real of left operand}
- end;
- if asp=realptr then genasp(op_dvf) else errasp(+0199);
- end;
- divsy:
- if (asp=intptr) or (asp=longptr) then genasp(op_dvi) else
- errasp(+0200);
- modsy:
- begin
- if asp=intptr then gensp(MDI,2*sz_int) else
- if asp=longptr then gensp(MDL,2*sz_long) else errasp(+0201);
- genasp(op_lfr);
- end;
- andsy:
- if asp=boolptr then genasp(op_and) else errasp(+0202);
- end {case}
- end {while}
-end end;
-
-procedure simpleexpression(fsys:sos);
-var lsy:symbol; lsp:sp; l1:integer; signed,min,first:boolean;
-begin with a do begin l1:=lino; first:=true;
- signed:=(sy=plussy) or (sy=minsy);
- if signed then begin min:=sy=minsy; insym end else min:=false;
- term(fsys + [minsy,plussy,orsy]); lsp:=desub(asp);
- if signed then
- if (lsp<>intptr) and (lsp<>realptr) and (lsp<>longptr) then
- errasp(+0203)
- else if min then
- begin load; first:=false; asp:=lsp; negate end;
- while find2([plussy,minsy,orsy],fsys,+0204) do
- begin if first then begin load; first:=false end;
- lsy:=sy; insym; l1:=lino; lsp:=asp;
- term(fsys+[minsy,plussy,orsy]); load; convert(lsp,l1);
- if asp<>nil then
- case lsy of
- plussy:
- if (asp=intptr) or (asp=longptr) then genasp(op_adi) else
- if asp=realptr then genasp(op_adf) else
- if asp^.form=power then genasp(op_ior) else errasp(+0205);
- minsy:
- if (asp=intptr) or (asp=longptr) then genasp(op_sbi) else
- if asp=realptr then genasp(op_sbf) else
- if asp^.form=power then begin genasp(op_com); genasp(op_and) end
- else errasp(+0206);
- orsy:
- if asp=boolptr then genasp(op_ior) else errasp(+0207);
- end {case}
- end {while}
-end end;
-
-procedure expression; { fsys:sos }
-var lsy:symbol; lsp:sp; l1,l2:integer;
-begin with a do begin l1:=lino;
- simpleexpression(fsys+[eqsy..insy]);
- if find2([eqsy..insy],fsys,+0208) then
- begin lsy:=sy; insym; lsp:=asp; loadcheap; l2:=lino;
- simpleexpression(fsys); loadcheap;
- if lsy=insy then
- begin
- if not formof(asp,[power]) then errasp(+0209) else
- if asp=nullset then genasp(op_and) else
- {this effectively replaces the word on top of the
- stack by the result of the 'in' operator: false }
- if not (compat(lsp,asp^.elset) <= subeq) then errasp(+0210) else
- begin exchange(l1,l2); genasp(op_inn) end
- end
- else
- begin convert(lsp,l2);
- if asp<>nil then
- case asp^.form of
- scalar:
- if asp=realptr then genasp(op_cmf) else genasp(op_cmi);
- pointer:
- if (lsy=eqsy) or (lsy=nesy) then genop(op_cmp) else
- errasp(+0211);
- power:
- case lsy of
- eqsy,nesy: genasp(op_cms);
- ltsy,gtsy: errasp(+0212);
- lesy: {'a<=b' equivalent to 'a-b=[]'}
- begin genasp(op_com); genasp(op_and); genasp(op_zer);
- genasp(op_cms); lsy:=eqsy
- end;
- gesy: {'a>=b' equivalent to 'a=a+b'}
- begin gencst(op_dup,2*sizeof(asp,wordmult));
- genasp(op_asp); genasp(op_ior);
- genasp(op_cms); lsy:=eqsy
- end
- end; {case}
- arrays:
- if string(asp) then
- begin gencst(op_loc,asp^.size);
- gensp(BCP,2*sz_addr+sz_word);
- gencst(op_lfr,sz_word)
- end
- else errasp(+0213);
- records: errasp(+0214);
- files: errasp(+0215)
- end; { case }
- case lsy of
- ltsy: genop(op_tlt);
- lesy: genop(op_tle);
- gtsy: genop(op_tgt);
- gesy: genop(op_tge);
- nesy: genop(op_tne);
- eqsy: genop(op_teq)
- end
- end;
- asp:=boolptr; ak:=loaded
- end;
-end end;
-
-{===================================================================}
-
-procedure statement(fsys:sos); forward;
- {this forward declaration can be avoided}
-
-procedure assignment(fsys:sos; fip:ip);
-var la:attr; l1,l2:integer;
-begin
- l1:=lino; selector(fsys+[becomes],fip,[assigned]); l2:=lino;
- la:=a; nextif(becomes,+0216);
- expression(fsys); loadcheap; checkasp(la.asp,+0217);
- exchange(l1,l2); a:=la;
- if not formof(la.asp,[arrays..records]) then store else
- begin loadaddr;
- if la.asp^.form<>carray then genasp(op_blm) else
- begin descraddr(la.asp^.arpos); gensp(ASZ,2*sz_addr);
- gencst(op_lfr,sz_word); gencst(op_bls,sz_word)
- end;
- end;
-end;
-
-procedure gotostatement;
-{jumps into structured statements can give strange results. }
-label 1;
-var llp:lp; lbp:bp; diff:integer;
-begin
- if sy<>intcst then error(+0218) else
- begin llp:=searchlab(b.lchain,val);
- if llp<>nil then gencst(op_bra,llp^.labname) else
- begin lbp:=b.nextbp; diff:=1;
- while lbp<>nil do
- begin llp:=searchlab(lbp^.lchain,val);
- if llp<>nil then goto 1;
- lbp:=lbp^.nextbp; diff:=diff+1;
- end;
-1: if llp=nil then errint(+0219,val) else
- begin
- if llp^.labdlb=0 then
- begin dlbno:=dlbno+1; llp^.labdlb:=dlbno;
- genop(ps_ina); argdlb(dlbno); {forward data reference}
- end;
- laedlb(llp^.labdlb);
- if diff=level-1 then gencst(op_zer,sz_addr) else
- gencst(op_lxl,diff);
- gensp(GTO,2*sz_addr);
- end;
- end;
- insym;
- end
-end;
-
-procedure compoundstatement(fsys:sos; err:integer);
-begin
- repeat statement(fsys+[semicolon])
- until endofloop(fsys,[beginsy..casesy],semicolon,err)
-end;
-
-procedure ifstatement(fsys:sos);
-var lb1,lb2:integer;
-begin with b do begin
- expression(fsys+[thensy,elsesy]);
- force(boolptr,+0220); ilbno:=ilbno+1; lb1:=ilbno; gencst(op_zeq,lb1);
- nextif(thensy,+0221); statement(fsys+[elsesy]);
- if find3(elsesy,fsys,+0222) then
- begin ilbno:=ilbno+1; lb2:=ilbno; gencst(op_bra,lb2);
- newilb(lb1); statement(fsys); newilb(lb2)
- end
- else newilb(lb1);
-end end;
-
-procedure casestatement(fsys:sos);
-label 1;
-type cip=^caseinfo;
- caseinfo=record
- next: cip;
- csstart: integer;
- cslab: integer
- end;
-var lsp:sp; head,p,q,r:cip; l0,l1:integer;
- ilb1,ilb2,dlb,i,n,m,min,max:integer;
-begin with b do begin
- expression(fsys+[ofsy,semicolon,ident..plussy]); lsp:=a.asp; load;
- if not nicescalar(desub(lsp)) then begin error(+0223); lsp:=nil end;
- l0:=lino; ilbno:=ilbno+1; ilb1:=ilbno;
- nextif(ofsy,+0224); head:=nil; max:=-MI2; min:=MI2; n:=0;
- repeat ilbno:=ilbno+1; ilb2:=ilbno; {label of current case}
- repeat i:=cstinteger(fsys+[comma,colon1,semicolon],lsp,+0225);
- if i>max then max:=i; if i<min then min:=i; n:=n+1;
- q:=head; r:=nil; new(p);
- while q<>nil do
- begin {chain all cases in ascending order}
- if q^.cslab>=i then
- begin if q^.cslab=i then error(+0226); goto 1 end;
- r:=q; q:=q^.next
- end;
-1: p^.next:=q; p^.cslab:=i; p^.csstart:=ilb2;
- if r=nil then head:=p else r^.next:=p;
- until endofloop(fsys+[colon1,semicolon],[ident..plussy],comma,+0227);
- {+0228}
- nextif(colon1,+0229); newilb(ilb2); statement(fsys+[semicolon]);
- gencst(op_bra,ilb1);
- until lastsemicolon(fsys,[ident..plussy],+0230); {+0231 +0232}
- assert n<>0; newilb(ilb1); l1:=lino;
- dlb:=newdlb; genop(ps_rom); argnil;
- if (max div 3) - (min div 3) < n then
- begin argcst(min); argcst(max-min);
- m:=op_csa;
- while head<>nil do
- begin
- while head^.cslab>min do
- begin argnil; min:=min+1 end;
- argilb(head^.csstart); min:=min+1; head:=head^.next
- end;
- end
- else
- begin argcst(n); m:=op_csb;
- while head<>nil do
- begin argcst(head^.cslab);argilb(head^.csstart);head:=head^.next end;
- end;
- argend; laedlb(dlb); gencst(m,sz_word); exchange(l0,l1)
-end end;
-
-procedure repeatstatement(fsys:sos);
-var lb1: integer;
-begin with b do begin
- ilbno:=ilbno+1; lb1:=ilbno; newilb(lb1);
- compoundstatement(fsys+[untilsy],+0233); {+0234}
- nextif(untilsy,+0235); genlin;
- expression(fsys); force(boolptr,+0236); gencst(op_zeq,lb1);
-end end;
-
-procedure whilestatement(fsys:sos);
-var lb1,lb2: integer;
-begin with b do begin
- ilbno:=ilbno+1; lb1:=ilbno; newilb(lb1);
- ilbno:=ilbno+1; lb2:=ilbno;
- genlin; expression(fsys+[dosy]);
- force(boolptr,+0237); gencst(op_zeq,lb2);
- nextif(dosy,+0238); statement(fsys);
- gencst(op_bra,lb1); newilb(lb2)
-end end;
-
-procedure forstatement(fsys:sos);
-var lip:ip; tosym:boolean; endlab,looplab,savlb:integer;
- av,at1,at2:attr; lsp:sp;
-
-procedure forbound(fsys:sos; var fa:attr; fsp:sp);
-begin
- expression(fsys); fa:=a; force(fsp,+0239);
- if fa.ak<>cst then
- begin temporary(fsp,reg_any);
- genasp(op_dup); fa:=a; store
- end
-end;
-
-begin with b do begin savlb:=reglb; tosym:=false;
- ilbno:=ilbno+1; looplab:=ilbno; ilbno:=ilbno+1; endlab:=ilbno;
- inita(nil,0);
- if sy<>ident then error(+0240) else
- begin lip:=searchid([vars]); insym;
- a.asp:=lip^.idtype; a.pos:=lip^.vpos;
- lip^.iflag:=lip^.iflag+[used,assigned,loopvar];
- if level>1 then
- if (a.pos.ad>=0) or (a.pos.lv<>level) then
- error(+0241);
- end;
- lsp:=desub(a.asp);
- if not nicescalar(lsp) then begin errasp(+0242); lsp:=nil end;
- av:=a; nextif(becomes,+0243);
- forbound(fsys+[tosy,downtosy,notsy..lparent,dosy],at1,lsp);
- if find1([tosy,downtosy],fsys+[notsy..lparent,dosy],+0244) then
- begin tosym:=sy=tosy; insym end;
- forbound(fsys+[dosy],at2,lsp);
- if tosym then gencst(op_bgt,endlab) else gencst(op_blt,endlab);
- a:=at1; force(av.asp,+0245); a:=av; store; newilb(looplab);
- nextif(dosy,+0246); statement(fsys);
- a:=av; load; a:=at2; load; gencst(op_beq,endlab);
- a:=av; load; if tosym then genop(op_inc) else genop(op_dec);
- a.asp:=lsp; checkbnds(av.asp); a:=av; store;
- gencst(op_bra,looplab); newilb(endlab);
- reglb:=savlb
-end end;
-
-procedure withstatement(fsys:sos);
-var lnp,savtop:np; savlb:integer; pbit:boolean;
-begin with b do begin
- savlb:=reglb; savtop:=top;
- repeat variable(fsys+[comma,dosy]);
- if not formof(a.asp,[records]) then errasp(+0247) else
- begin pbit:=spack in a.asp^.sflag;
- new(lnp,wrec); lnp^.occur:=wrec; lnp^.fname:=a.asp^.fstfld;
- if a.ak<>fixed then
- begin loadaddr; temporary(nilptr,reg_pointer); store;
- a.ak:=pfixed;
- end;
- a.packbit:=pbit; lnp^.wa:=a; lnp^.nlink:=top; top:=lnp;
- end;
- until endofloop(fsys+[dosy],[ident],comma,+0248); {+0249}
- nextif(dosy,+0250); statement(fsys);
- top:=savtop; reglb:=savlb;
-end end;
-
-procedure assertion(fsys:sos);
-begin teststandard;
- if opt['a']=off then
- while not (sy in fsys) do insym
- else
- begin expression(fsys); force(boolptr,+0251);
- gencst(op_loc,srcorig); gensp(ASS,2*sz_word);
- end
-end;
-
-procedure statement; {fsys: sos}
-var lip:ip; llp:lp; lsy:symbol;
-begin
- assert [labelsy..casesy,endsy] <= fsys;
- assert [ident,intcst] * fsys = [];
- if find2([intcst],fsys+[ident],+0252) then
- begin llp:=searchlab(b.lchain,val);
- if llp=nil then errint(+0253,val) else
- begin if llp^.seen then errint(+0254,val) else llp^.seen:=true;
- newilb(llp^.labname)
- end;
- insym; nextif(colon1,+0255);
- end;
- if find2([ident,beginsy..casesy],fsys,+0256) then
- begin if giveline then if sy<>whilesy then genlin;
- if sy=ident then
- if id='assert ' then
- begin insym; assertion(fsys) end
- else
- begin lip:=searchid([vars,field,func,proc]); insym;
- if lip^.klass=proc then call(fsys,lip) else assignment(fsys,lip)
- end
- else
- begin lsy:=sy; insym;
- case lsy of
- beginsy:
- begin compoundstatement(fsys,+0257); {+0258}
- nextif(endsy,+0259)
- end;
- gotosy:
- gotostatement;
- ifsy:
- ifstatement(fsys);
- casesy:
- begin casestatement(fsys); nextif(endsy,+0260) end;
- whilesy:
- whilestatement(fsys);
- repeatsy:
- repeatstatement(fsys);
- forsy:
- forstatement(fsys);
- withsy:
- withstatement(fsys);
- end
- end;
- end
-end;
-
-{===================================================================}
-
-procedure body(fsys:sos; fip:ip);
-var i,dlb,l0,l1,ssp:integer; llp:lp; spset:boolean;
-begin with b do begin
-{produce PRO}
- genpnam(ps_pro,fip); argend;
- gencst(ps_mes,ms_par);argcst(fip^.maxlb); argend;
- l0:=lino; dlb:=0; trace('procentr',fip,dlb);
-{global labels}
- llp:=lchain; spset:=false;
- while llp<>nil do
- begin
- if llp^.labdlb<>0 then
- begin
- if not spset then
- begin spset:=true;
- gencst(ps_mes,ms_gto); argend;
- temporary(nilptr,-1); ssp:=a.pos.ad;
- gencst(op_lor,1); store
- end;
- argdlb(llp^.labdlb); lino:=lino+1; genop(ps_rom);
- argilb(llp^.labname); argcst(ssp); argend;
- end;
- llp:=llp^.nextlp
- end;
-{the body itself}
- currproc:=fip;
- compoundstatement(fsys,+0261); {+0262}
- trace('procexit',fip,dlb);
-{undefined labels}
- llp:=lchain;
- while llp<>nil do
- begin if not llp^.seen then errint(+0263,llp^.labval);
- llp:=llp^.nextlp
- end;
-{finish and close files}
- treewalk(top^.fname);
- if level=1 then
- begin l1:=lino;
- genop(op_fil); argdlb(fildlb); {temporarily}
- dlb:=newdlb; gencst(ps_con,argc+1);
- for i:=0 to argc do with argv[i] do
- begin argcst(ad);
- if (ad=-1) and (i>1) then errid(+0264,name)
- end;
- argend; gencst(op_lxl,0); laedlb(dlb); gencst(op_lae,0);
- gencst(op_lxa,0); gensp(INI,4*sz_addr);
- exchange(l0,l1); gencst(op_loc,0); gensp(HLT,0)
- end
- else
- begin inita(fip^.idtype,fip^.pfpos.ad);
- if fip^.klass=func then
- begin load;
- if not (assigned in fip^.iflag) then
- errid(-(+0265),fip^.name);
- end;
- genasp(op_ret);
- end;
- gencst(ps_end,-minlb);
-end end;
-
-{===================================================================}
-
-procedure block; {forward declared}
-begin with b do begin
- assert [labelsy..withsy] <= fsys;
- assert [ident,intcst,casesy,endsy,period] * fsys = [];
- if find3(labelsy,fsys,+0266) then labeldeclaration(fsys);
- if find3(constsy,fsys,+0267) then constdefinition(fsys);
- if find3(typesy,fsys,+0268) then typedefinition(fsys);
- if find3(varsy,fsys,+0269) then vardeclaration(fsys);
- if fip=progp then
- begin
- if iop[true]<>nil then
- begin argv[1].ad:=posaddr(holeb,textptr,false);
- iop[true]^.vpos.ad:=argv[1].ad
- end;
- if iop[false]<>nil then
- begin argv[0].ad:=posaddr(holeb,textptr,false);
- iop[false]^.vpos.ad:=argv[0].ad
- end;
- genhol; genpnam(ps_exp,fip);
- end; {externals are also extern for the main body}
- fip^.pfpos.ad:=negaddr(fip^.idtype); {function result area}
- while find2([procsy,funcsy],fsys,+0270) do pfdeclaration(fsys);
- if forwcount<>0 then error(+0271); {forw proc not specified}
- nextif(beginsy,+0272);
- body(fsys+[casesy,endsy],fip);
- nextif(endsy,+0273);
-end end;
-
-{===================================================================}
-
-procedure programme(fsys:sos);
-var stdin,stdout:boolean; p:ip;
-begin
- nextif(progsy,+0274); nextif(ident,+0275);
- if find3(lparent,fsys+[semicolon],+0276) then
- begin
- repeat
- if sy<>ident then error(+0277) else
- begin stdin:=id='input '; stdout:=id='output ';
- if stdin or stdout then
- begin p:=newip(vars,id,textptr,nil);
- enterid(p); iop[stdout]:=p;
- end
- else
- if argc<maxargc then
- begin
- argc:=argc+1; argv[argc].name:=id; argv[argc].ad:=-1
- end;
- insym
- end
- until endofloop(fsys+[rparent,semicolon],[ident],comma,+0278); {+0279}
- if argc>maxargc then
- begin error(+0280); argc:=maxargc end;
- nextif(rparent,+0281);
- end;
- nextif(semicolon,+0282);
- block(fsys,progp);
- if opt['l']<>off then
- begin gencst(ps_mes,ms_src); argcst(srcorig); argend end;
- eofexpected:=true; nextif(period,+0283);
-end;
-
-procedure compile;
-var lsys:sos;
-begin lsys:=[progsy,labelsy..withsy];
- repeat eofexpected:=false;
- main:=find2([progsy,labelsy,beginsy..withsy],lsys,+0284);
- if main then programme(lsys) else
- begin
- if find3(constsy,lsys,+0285) then constdefinition(lsys);
- if find3(typesy,lsys,+0286) then typedefinition(lsys);
- if find3(varsy,lsys,+0287) then vardeclaration(lsys);
- genhol;
- while find2([procsy,funcsy],lsys,+0288) do pfdeclaration(lsys);
- end;
- error(+0289);
- until false; { the only way out is the halt in nextln on eof }
-end;
-
-{===================================================================}
-
-procedure init1;
-var c:char;
-begin
-{reserved words}
- rw[ 0]:='if '; rw[ 1]:='do '; rw[ 2]:='of ';
- rw[ 3]:='to '; rw[ 4]:='in '; rw[ 5]:='or ';
- rw[ 6]:='end '; rw[ 7]:='for '; rw[ 8]:='nil ';
- rw[ 9]:='var '; rw[10]:='div '; rw[11]:='mod ';
- rw[12]:='set '; rw[13]:='and '; rw[14]:='not ';
- rw[15]:='then '; rw[16]:='else '; rw[17]:='with ';
- rw[18]:='case '; rw[19]:='type '; rw[20]:='goto ';
- rw[21]:='file '; rw[22]:='begin '; rw[23]:='until ';
- rw[24]:='while '; rw[25]:='array '; rw[26]:='const ';
- rw[27]:='label '; rw[28]:='repeat '; rw[29]:='record ';
- rw[30]:='downto '; rw[31]:='packed '; rw[32]:='program ';
- rw[33]:='function'; rw[34]:='procedur';
-{corresponding symbols}
- rsy[ 0]:=ifsy; rsy[ 1]:=dosy; rsy[ 2]:=ofsy;
- rsy[ 3]:=tosy; rsy[ 4]:=insy; rsy[ 5]:=orsy;
- rsy[ 6]:=endsy; rsy[ 7]:=forsy; rsy[ 8]:=nilcst;
- rsy[ 9]:=varsy; rsy[10]:=divsy; rsy[11]:=modsy;
- rsy[12]:=setsy; rsy[13]:=andsy; rsy[14]:=notsy;
- rsy[15]:=thensy; rsy[16]:=elsesy; rsy[17]:=withsy;
- rsy[18]:=casesy; rsy[19]:=typesy; rsy[20]:=gotosy;
- rsy[21]:=filesy; rsy[22]:=beginsy; rsy[23]:=untilsy;
- rsy[24]:=whilesy; rsy[25]:=arraysy; rsy[26]:=constsy;
- rsy[27]:=labelsy; rsy[28]:=repeatsy; rsy[29]:=recordsy;
- rsy[30]:=downtosy; rsy[31]:=packedsy; rsy[32]:=progsy;
- rsy[33]:=funcsy; rsy[34]:=procsy;
-{indices into rw to find reserved words fast}
- frw[0]:= 0; frw[1]:= 0; frw[2]:= 6; frw[3]:=15; frw[4]:=22;
- frw[5]:=28; frw[6]:=32; frw[7]:=33; frw[8]:=35;
-{char types}
- for c:=chr(0) to chr(maxcharord) do cs[c]:=others;
- for c:='0' to '9' do cs[c]:=digit;
- for c:='A' to 'Z' do cs[c]:=upper;
- for c:='a' to 'z' do cs[c]:=lower;
- cs[chr(ascnl)]:=layout;
- cs[chr(ascvt)]:=layout;
- cs[chr(ascff)]:=layout;
- cs[chr(asccr)]:=layout;
-{characters with corresponding chartype in ASCII order}
- cs[chr(ascht)]:=tabch;
- cs[' ']:=layout; cs['"']:=dquotech; cs['''']:=quotech;
- cs['(']:=lparentch; cs[')']:=rparentch; cs['*']:=star;
- cs['+']:=plusch; cs[',']:=commach; cs['-']:=minch;
- cs['.']:=periodch; cs['/']:=slash; cs[':']:=colonch;
- cs[';']:=semich; cs['<']:=lessch; cs['=']:=equal;
- cs['>']:=greaterch; cs['[']:=lbrackch; cs[']']:=rbrackch;
- cs['^']:=arrowch; cs['{']:=lbracech;
-{single character symbols in chartype order}
- csy[rparentch]:=rparent; csy[lbrackch]:=lbrack;
- csy[rbrackch]:=rbrack; csy[commach]:=comma;
- csy[semich]:=semicolon; csy[arrowch]:=arrow;
- csy[plusch]:=plussy; csy[minch]:=minsy;
- csy[slash]:=slashsy; csy[star]:=starsy;
- csy[equal]:=eqsy;
-{pascal library mnemonics}
- lmn[ELN ]:='_eln'; lmn[EFL ]:='_efl'; lmn[CLS ]:='_cls';
- lmn[WDW ]:='_wdw';
- lmn[OPN ]:='_opn'; lmn[GETX]:='_get'; lmn[RDI ]:='_rdi';
- lmn[RDC ]:='_rdc'; lmn[RDR ]:='_rdr'; lmn[RDL ]:='_rdl';
- lmn[RLN ]:='_rln';
- lmn[CRE ]:='_cre'; lmn[PUTX]:='_put'; lmn[WRI ]:='_wri';
- lmn[WSI ]:='_wsi'; lmn[WRC ]:='_wrc'; lmn[WSC ]:='_wsc';
- lmn[WRS ]:='_wrs'; lmn[WSS ]:='_wss'; lmn[WRB ]:='_wrb';
- lmn[WSB ]:='_wsb'; lmn[WRR ]:='_wrr'; lmn[WSR ]:='_wsr';
- lmn[WRL ]:='_wrl'; lmn[WSL ]:='_wsl';
- lmn[WRF ]:='_wrf'; lmn[WRZ ]:='_wrz'; lmn[WSZ ]:='_wsz';
- lmn[WLN ]:='_wln'; lmn[PAG ]:='_pag';
- lmn[ABR ]:='_abr'; lmn[RND ]:='_rnd'; lmn[SINX]:='_sin';
- lmn[COSX]:='_cos'; lmn[EXPX]:='_exp'; lmn[SQT ]:='_sqt';
- lmn[LOG ]:='_log'; lmn[ATN ]:='_atn'; lmn[ABI ]:='_abi';
- lmn[ABL ]:='_abl';
- lmn[BCP ]:='_bcp'; lmn[BTS ]:='_bts'; lmn[NEWX]:='_new';
- lmn[SAV ]:='_sav'; lmn[RST ]:='_rst'; lmn[INI ]:='_ini';
- lmn[HLT ]:='_hlt'; lmn[ASS ]:='_ass'; lmn[GTO ]:='_gto';
- lmn[PAC ]:='_pac'; lmn[UNP ]:='_unp'; lmn[DIS ]:='_dis';
- lmn[ASZ ]:='_asz'; lmn[MDI ]:='_mdi'; lmn[MDL ]:='_mdl';
-{scalar variables}
- b.nextbp:=nil;
- b.reglb:=0;
- b.minlb:=0;
- b.ilbno:=0;
- b.forwcount:=0;
- b.lchain:=nil;
- srcchno:=0;
- srclino:=1;
- srcorig:=1;
- lino:=0;
- dlbno:=0;
- holeb:=0;
- argc:=1;
- lastpfno:=0;
- giveline:=true;
- including:=false;
- eofexpected:=false;
- intypedec:=false;
- fltused:=false;
- seconddot:=false;
- iop[false]:=nil;
- iop[true]:=nil;
- argv[0].ad:=-1;
- argv[1].ad:=-1;
-end;
-
-procedure init2;
-var p:ip; k:idclass; j:standpf;
- pfn:array[standpf] of idarr;
-begin
-{initialize the first name space}
- new(top,blck); top^.occur:=blck; top^.nlink:=nil; top^.fname:=nil;
- level:=0;
-{undefined identifier pointers used by searchid}
- for k:=types to func do
- undefip[k]:=newip(k,spaces,nil,nil);
-{names of standard procedures/functions}
- pfn[pread ]:='read '; pfn[preadln ]:='readln ';
- pfn[pwrite ]:='write '; pfn[pwriteln ]:='writeln ';
- pfn[pput ]:='put '; pfn[pget ]:='get ';
- pfn[ppage ]:='page '; pfn[preset ]:='reset ';
- pfn[prewrite ]:='rewrite '; pfn[pnew ]:='new ';
- pfn[pdispose ]:='dispose '; pfn[ppack ]:='pack ';
- pfn[punpack ]:='unpack '; pfn[pmark ]:='mark ';
- pfn[prelease ]:='release '; pfn[phalt ]:='halt ';
- pfn[feof ]:='eof '; pfn[feoln ]:='eoln ';
- pfn[fabs ]:='abs '; pfn[fsqr ]:='sqr ';
- pfn[ford ]:='ord '; pfn[fchr ]:='chr ';
- pfn[fpred ]:='pred '; pfn[fsucc ]:='succ ';
- pfn[fodd ]:='odd '; pfn[ftrunc ]:='trunc ';
- pfn[fround ]:='round '; pfn[fsin ]:='sin ';
- pfn[fcos ]:='cos '; pfn[fexp ]:='exp ';
- pfn[fsqt ]:='sqrt '; pfn[flog ]:='ln ';
- pfn[fatn ]:='arctan ';
-{standard procedure/function identifiers}
- for j:=pread to phalt do
- begin new(p,proc,standard); p^.klass:=proc;
- p^.name:=pfn[j]; p^.pfkind:=standard; p^.key:=j; enterid(p);
- end;
- for j:=feof to fatn do
- begin new(p,func,standard); p^.klass:=func; p^.idtype:=nil;
- p^.name:=pfn[j]; p^.pfkind:=standard; p^.key:=j; enterid(p);
- end;
-{program identifier}
- progp:=newip(proc,'m_a_i_n ',nil,nil);
-end;
-
-procedure init3;
-var n:np; p,q:ip; i:integer; c:char;
-begin
- for i:=0 to sz_last do readln(errors,sizes[i]);
- gencst(ps_mes,ms_emx); argcst(sz_word); argcst(sz_addr); argend;
- ix:=1;
- while not eoln(errors) do
- begin read(errors,c);
- if ix<smax then begin strbuf[ix]:=c; ix:=ix+1 end
- end;
- readln(errors); strbuf[ix]:=chr(0);
- for i:=1 to fnmax do
- if i<ix then source[i]:=strbuf[i] else source[i]:=' ';
- fildlb:=romstr(sp_scon,0);
-{standard type pointers}
- intptr :=newsp(scalar,sz_int);
- realptr:=newsp(scalar,sz_real);
- longptr:=newsp(scalar,sz_long);
- charptr:=newsp(scalar,sz_char);
- boolptr:=newsp(scalar,sz_bool);
- nilptr :=newsp(pointer,sz_addr);
- zeroptr:=newsp(pointer,sz_addr);
- procptr:=newsp(records,sz_proc);
- nullset:=newsp(power,sz_word); nullset^.elset:=nil;
- textptr:=newsp(files,sz_head+sz_buff); textptr^.filtype:=charptr;
-{standard type names}
- enterid(newip(types,'integer ',intptr,nil));
- enterid(newip(types,'real ',realptr,nil));
- enterid(newip(types,'char ',charptr,nil));
- enterid(newip(types,'boolean ',boolptr,nil));
- enterid(newip(types,'text ',textptr,nil));
-{standard constant names}
- q:=nil; p:=newip(konst,'false ',boolptr,q); enterid(p);
- q:=p; p:=newip(konst,'true ',boolptr,q); p^.value:=1; enterid(p);
- boolptr^.fconst:=p;
- p:=newip(konst,'maxint ',intptr,nil); p^.value:=MI2; enterid(p);
- p:=newip(konst,spaces,charptr,nil); p^.value:=maxcharord;
- charptr^.fconst:=p;
-{new name space for user externals}
- new(n,blck); n^.occur:=blck; n^.nlink:=top; n^.fname:=nil; top:=n;
-{options}
- for c:='a' to 'z' do begin opt[c]:=0; forceopt[c]:=false end;
- opt['a']:=on;
- opt['i']:=NB1*sz_iset;
- opt['l']:=on;
- opt['o']:=on;
- opt['r']:=on;
- sopt:=off;
-end;
-
-procedure init4;
-begin
- copt:=opt['c'];
- dopt:=opt['d'];
- iopt:=opt['i'];
- sopt:=opt['s'];
- if sopt<>off then begin copt:=off; dopt:=off end
- else if opt['u']<>off then cs['_']:=lower;
- if copt<>off then enterid(newip(types,'string ',zeroptr,nil));
- if dopt<>off then enterid(newip(types,'long ',longptr,nil));
- if opt['o']=off then begin gencst(ps_mes,ms_opt); argend end;
- if dopt<>off then fltused:=true; {temporary kludge}
-end;
-
-begin {main body of pcompiler}
- init1; {initialize tables and scalars}
- init2; {initialize heap objects}
- rewrite(em); put2(sp_magic); reset(errors);
- init3; {size dependent initialization}
- while not eof(errors) do
- begin options(false); readln(errors) end;
- rewrite(errors);
- if not eof(input) then
- begin nextch; insym;
- init4; {option dependent initialization}
- compile
- end;
-#ifdef STANDARD
-9999: ;
-#endif
-end. {pcompiler}
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m6500
-var M=6500
-var LIB=mach/6500/lib/tail_
-var RT=mach/6500/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) -o > (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var i=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m6809
-var M=6809
-var LIB=mach/6809/lib/tail_
-var RT=mach/6809/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=4
-var M=cpm
-var NAME=CPM
-var LIB=mach/z80/int/lib/tail_
-var RT=mach/z80/int/lib/head_
-var SIZE_F=-sm
-var INCLUDES=-I{EM}/include
-name asld
- from .k.m.a
- to e.out
- program {EM}/lib/em_ass
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -+* ASS_F={ASS_F?} -+*
- mapflag --* ASS_F={ASS_F?} --*
- mapflag -s* SIZE_F=-s*
- args {ASS_F?} ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p:{TAIL}={EM}/{LIB}mon)
- prop C
-end
+++ /dev/null
-# (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
-name cpp
- # no from, it's governed by the P property
- to .i
- program {EM}/lib/cpp
- mapflag -I* CPP_F={CPP_F?} -I*
- mapflag -U* CPP_F={CPP_F?} -U*
- mapflag -D* CPP_F={CPP_F?} -D*
- args {CPP_F?} {INCLUDES?} -D{NAME} -DEM_WSIZE={w} -DEM_PSIZE={p} \
--DEM_SSIZE={s} -DEM_LSIZE={l} -DEM_FSIZE={f} -DEM_DSIZE={d} <
- prop >P
-end
-name cem
- from .c
- to .k
- program {EM}/lib/em_cem
- mapflag -p CEM_F={CEM_F?} -Xp
- mapflag -L CEM_F={CEM_F?} -l
- args -Vw{w}i{w}p{p}f{f}s{s}l{l}d{d} {CEM_F?}
- prop <>p
- rts .c
- need .c
-end
-name pc
- from .p
- to .k
- program {EM}/lib/em_pc
- mapflag -p PC_F={PC_F?} -p
- mapflag -w PC_F={PC_F?} -w
- mapflag -E PC_F={PC_F?} -E
- mapflag -e PC_F={PC_F?} -e
- mapflag -{*} PC_F={PC_F?} -\{*}
- mapflag -L PC_F={PC_F?} -\{l-}
- args -Vw{w}p{p}f{d}l{l} {PC_F?} < > {SOURCE}
- prop m
- rts .p
- need .p
- end
- name encode
- from .e
- to .k
- program {EM}/lib/em_encode
- args <
- prop >m
-end
-name opt
- from .k
- to .m
- program {EM}/lib/em_opt
- mapflag -LIB OPT_F={OPT_F?} -L
- args {OPT_F?} <
- prop >O
-end
-name decode
- from .k.m
- to .e
- program {EM}/lib/em_decode
- args <
- prop >
-end
+++ /dev/null
-var w=1
-var p=2
-var s=1
-var l=2
-var f=4
-var d=8
-var NAME=nascom
-var M=z80a
-var LIB=mach/z80a/lib/tail_
-var RT=mach/z80a/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) ({RTS}:.c={EM}/{RT}cc) -o > \
-(.e:{TAIL}={EM}/{LIB}em.1 {EM}/{LIB}em.2)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var M=int
-var NAME=int22
-var LIB=mach/int/lib/tail_
-var RT=mach/int/lib/head_
-var SIZE_FLAG=-sm
-var INCLUDES=-I{EM}/include
-name asld
- from .k.m.a
- to e.out
- program {EM}/lib/em_ass
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -+* ASS_F={ASS_F?} -+*
- mapflag --* ASS_F={ASS_F?} --*
- mapflag -s* SIZE_FLAG=-s*
- args {SIZE_FLAG} \
- ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
- (.p:{TAIL}={EM}/{LIB}pc) \
- (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
- (.c.p:{TAIL}={EM}/{LIB}mon)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8080
-var M=8080
-var LIB=mach/8080/lib/tail_
-var RT=mach/8080/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args ({RTS}:.c={EM}/{RT}cc) -o > <
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8086
-var M=i86
-var LIB=mach/i86/lib/tail_
-var RT=mach/i86/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i IFILE={EM}/{RT}i
- args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p.e:{TAIL}={EM}/{LIB}alo) (.c.p:{TAIL}={EM}/{LIB}mon) \
-(.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m68k2
-var M=m68k2
-var LIB=mach/m68k2/lib/tail_
-var RT=mach/m68k2/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon {EM}/{LIB}em.vend)
- prop Cm
-end
+++ /dev/null
-var w=4
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m68k4
-var M=m68k4
-var LIBDIR=mach/m68k4/lib
-var LIB=mach/m68k4/lib/tail_
-var RT=mach/m68k4/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p.c:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \
-(.c:{TAIL}={EM}/{LIBDIR}/write.s) \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \
-(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend)
- prop Cm
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var M=pdp
-var NAME=pdp
-var LIB=mach/pdp/lib/tail_
-var RT=mach/pdp/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name as
- from .s
- to .o
- program /bin/as
- args - -o > <
- prop m
-end
-name ld
- from .o.a
- to a.out
- program /bin/ld
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
- ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
- (.p:{TAIL}={EM}/{LIB}pc) \
- (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
- (.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}=/lib/libc.a)
- prop C
-end
+++ /dev/null
-var w=4
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var M=vax4
-var NAME=vax4
-var LIB=mach/vax4/lib/tail_
-var RT=mach/vax4/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name as
- from .s
- to .o
- program /bin/as
- args - -o > <
- prop m
-end
-name ld
- from .o.a
- to a.out
- program /bin/ld
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}={EM}/{LIB}mon)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=z80
-var M=z80
-var LIB=mach/z80/lib/tail_
-var RT=mach/z80/lib/head_
-var INCLUDES=-I{EM}/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p.e:{TAIL}={EM}/{LIB}alo) (.c.p:{TAIL}={EM}/{LIB}mon) \
-(.e:{TAIL}={EM}/{LIB}em.vend)
- prop C
-end
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/*
- * machine dependent back end routines for the PDP-11
- */
-
-#define REGPATCH
-
-con_part(sz,w) register sz; word w; {
-
- while (part_size % sz)
- part_size++;
- if (part_size == EM_WSIZE)
- part_flush();
- if (sz == 1) {
- w &= 0xFF;
- if (part_size)
- w <<= 8;
- part_word |= w;
- } else {
- assert(sz == 2);
- part_word = w;
- }
- part_size += sz;
-}
-
-con_mult(sz) word sz; {
- long l;
-
- if (sz != 4)
- fatal("bad icon/ucon size");
- l = atol(str);
- fprintf(codefile,"\t%o;%o\n",(int)(l>>16),(int)l);
-}
-
-con_float() {
- double f;
- register short *p,i;
-
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- f = atof(str);
- p = (short *) &f;
- i = *p++;
- if (argval == 8) {
- fprintf(codefile,"\t%o;%o;",i,*p++);
- i = *p++;
- }
- fprintf(codefile,"\t%o;%o\n",i,*p++);
-}
-
-#ifdef REGVARS
-
-char Rstring[10] = "RT";
-
-regscore(off,size,typ,score,totyp) long off; {
-
- if (size != 2)
- return(-1);
- score -= 1; /* allow for save/restore */
- if (off>=0)
- score -= 2;
- if (typ==reg_pointer)
- score *= 17;
- else if (typ==reg_loop)
- score = 10*score+50; /* Guestimate */
- else
- score *= 10;
- return(score); /* estimated # of words of profit */
-}
-
-i_regsave() {
-
- Rstring[2] = 0;
-}
-
-f_regsave() {}
-
-regsave(regstr,off,size) char *regstr; long off; {
-
- fprintf(codefile,"/ Local %ld into %s\n",off,regstr);
-#ifndef REGPATCH
- fprintf(codefile,"mov %s,-(sp)\n",regstr);
-#endif
- strcat(Rstring,regstr);
- if (off>=0)
- fprintf(codefile,"mov 0%lo(r5),%s\n",off,regstr);
-}
-
-regreturn() {
-
-#ifdef REGPATCH
- fprintf(codefile,"jmp eret\n");
-#else
- fprintf(codefile,"jmp %s\n",Rstring);
-#endif
-}
-
-#endif
-
-prolog(nlocals) full nlocals; {
-
-#ifdef REGPATCH
- fprintf(codefile,"mov r2,-(sp)\nmov r4,-(sp)\n");
-#endif
- fprintf(codefile,"mov r5,-(sp)\nmov sp,r5\n");
- if (nlocals == 0)
- return;
- if (nlocals == 2)
- fprintf(codefile,"tst -(sp)\n");
- else
- fprintf(codefile,"sub $0%o,sp\n",nlocals);
-}
-
-dlbdlb(as,ls) string as,ls; {
-
- if (strlen(as)+strlen(ls)+2<sizeof(labstr)) {
- strcat(ls,":");
- strcat(ls,as);
- } else
- fatal("too many consecutive labels");
-}
-
-mes(type) word type; {
- int argt ;
-
- switch ( (int)type ) {
- case ms_ext :
- for (;;) {
- switch ( argt=getarg(
- ptyp(sp_cend)|ptyp(sp_pnam)|sym_ptyp) ) {
- case sp_cend :
- return ;
- default:
- strarg(argt) ;
- fprintf(codefile,".globl %s\n",argstr) ;
- break ;
- }
- }
- default :
- while ( getarg(any_ptyp) != sp_cend ) ;
- break ;
- }
-}
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".bss" /* SEGBSS */
-};
+++ /dev/null
-/* $Header$ */
-
-#define ex_ap(y) fprintf(codefile,"\t.globl %s\n",y)
-#define in_ap(y) /* nothing */
-
-#define newilb(x) fprintf(codefile,"%s:\n",x)
-#define newdlb(x) fprintf(codefile,"%s:\n",x)
-#define newlbss(l,x) fprintf(codefile,"%s:.=.+0%o\n",l,x);
-
-#define cst_fmt "$0%o"
-#define off_fmt "0%o"
-#define ilb_fmt "I%02x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "0%o+hol%d"
-
-#define con_cst(x) fprintf(codefile,"0%o\n",x)
-#define con_ilb(x) fprintf(codefile,"%s\n",x)
-#define con_dlb(x) fprintf(codefile,"%s\n",x)
-
-#define id_first '_'
-#define BSS_INIT 0
+++ /dev/null
-"$Header$"
-/********************************************************
- * Back end tables for pdp 11 *
- * Authors : Ceriel J.H. Jacobs,Hans van Staveren *
- * *
- * wordsize = 2 bytes, pointersize = 2 bytes. *
- * *
- * Register r5 is used for the LB, the stack pointer *
- * is used for SP. Also some global variables are used: *
- * - reghp~ : the heap pointer *
- * - trpim~ : trap ignore mask *
- * - trppc~ : address of user defined trap handler *
- * - retar : function return area for size>4 *
- * *
- * Timing is based on the timing information available *
- * for the 11/45. Hardware floating point processor is *
- * assumed. *
- ********************************************************/
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#define REGPATCH /* save all registers in link block */
-
-#ifdef REGPATCH
-#define SL 8
-#define SSL "010"
-#else REGPATCH
-#define SL 4
-#define SSL "4"
-#endif REGPATCH
-
-#define NC nocoercions:
-
-/* options */
-/* #define DORCK /* rck is expanded instead of thrown away */
-#define REGVARS /* use register variables */
-
-EM_WSIZE=2
-EM_PSIZE=2
-EM_BSIZE=SL
-
-TIMEFACTOR= 1/300
-FORMAT="0%o"
-
-REGISTERS:
-r0 = ("r0", 2), REG.
-r1 = ("r1", 2), REG, ODD_REG.
-#ifdef REGVARS
-r2 = ("r2", 2) regvar, REG.
-#else
-/* r2 = ("r2", 2), REG. */
-#endif
-r3 = ("r3", 2), REG, ODD_REG.
-#ifdef REGVARS
-r4 = ("r4", 2) regvar, REG.
-#else
-/* r4 = ("r4", 2), REG. */
-#endif
-lb = ("r5", 2), localbase.
-r01 = ("r0", 4, r0, r1), REG_PAIR.
-#ifndef REGVARS
-/* r23 = ("r2", 4, r2, r3), REG_PAIR. */
-#endif
-fr0 = ("fr0", 4), FLT_REG.
-fr1 = ("fr1", 4), FLT_REG.
-fr2 = ("fr2", 4), FLT_REG.
-fr3 = ("fr3", 4), FLT_REG.
-fr01 = ("fr0", 8, fr0, fr1), FLT_REG_PAIR.
-fr23 = ("fr2", 8, fr2, fr3), FLT_REG_PAIR.
-dr0 = ("fr0", 8, fr0), DBL_REG.
-dr1 = ("fr1", 8, fr1), DBL_REG.
-dr2 = ("fr2", 8, fr2), DBL_REG.
-dr3 = ("fr3", 8, fr3), DBL_REG.
-dr01 = ("fr0", 16, dr0, dr1), DBL_REG_PAIR.
-dr23 = ("fr2", 16, dr2, dr3), DBL_REG_PAIR.
-
-TOKENS:
-
-/********************************
- * Types on the EM-machine *
- ********************************/
-
-CONST2 = {INT num;} 2 cost=(2,300) "$%[num]"
-LOCAL2 = {INT ind,size;} 2 cost=(2,600) "%[ind](r5)"
-LOCAL4 = {INT ind,size;} 4 cost=(2,1200) "%[ind](r5)"
-ADDR_LOCAL = {INT ind;} 2
-ADDR_EXTERNAL = {STRING ind;} 2 cost=(2,300) "$%[ind]"
-
-/********************************************************
- * Now mostly addressing modes of target machine *
- ********************************************************/
-
-regdef2 = {REGISTER reg;} 2 cost=(0,300) "*%[reg]"
-regind2 = {REGISTER reg; STRING ind;} 2 cost=(2,600) "%[ind](%[reg])"
-reginddef2 = {REGISTER reg; STRING ind;} 2 cost=(2,1050) "*%[ind](%[reg])"
-regconst2 = {REGISTER reg; STRING ind;} 2
-/********************************************************
- * This means : add "reg" and "ind" to get address. *
- * Not really addressable on the PDP 11 *
- ********************************************************/
-relative2 = {STRING ind;} 2 cost=(2,600) "%[ind]"
-reldef2 = {STRING ind;} 2 cost=(2,1050) "*%[ind]"
-regdef1 = {REGISTER reg;} 2 cost=(0,300) "*%[reg]"
-regind1 = {REGISTER reg; STRING ind;} 2 cost=(2,600) "%[ind](%[reg])"
-reginddef1 = {REGISTER reg; STRING ind;} 2 cost=(2,1050) "*%[ind](%[reg])"
-relative1 = {STRING ind;} 2 cost=(2,600) "%[ind]"
-reldef1 = {STRING ind;} 2 cost=(2,1050) "*%[ind]"
-
-/************************************************************************
- * fto* are floats converted to *, conversion is delayed to be combined *
- * with store. *
- ************************************************************************/
-
-ftoint = {REGISTER reg;} 2
-ftolong = {REGISTER reg;} 4
-
-/************************************************************************
- * ...4 and ...8 are only addressable by the floating point processor. *
- ************************************************************************/
-
-regind4 = {REGISTER reg; STRING ind; } 4 cost=(2,3630) "%[ind](%[reg])"
-relative4 = {STRING ind; } 4 cost=(2,3630) "%[ind]"
-regdef4 = {REGISTER reg;} 4 cost=(2,3240) "*%[reg]"
-regdef8 = {REGISTER reg;} 8 cost=(2,5220) "*%[reg]"
-relative8 = {STRING ind; } 8 cost=(2,5610) "%[ind]"
-regind8 = {REGISTER reg; STRING ind;} 8 cost=(2,5610) "%[ind](%[reg])"
-
-TOKENEXPRESSIONS:
-SCR_REG = REG * SCRATCH
-SCR_FLT_REG = FLT_REG * SCRATCH
-SCR_DBL_REG = DBL_REG * SCRATCH
-SCR_ODD_REG = ODD_REG * SCRATCH
-SCR_REG_PAIR = REG_PAIR * SCRATCH
-all= ALL
-source2 = REG + regdef2 + regind2 + reginddef2 + localbase +
- relative2 + reldef2 + ADDR_EXTERNAL + CONST2 + LOCAL2
-xsource2 = source2 + ftoint
-source1 = regdef1 + regind1 + reginddef1 + relative1 +
- reldef1
-source1or2 = source1 + source2
-long4 = relative4 + regdef4 + LOCAL4 + regind4 + REG_PAIR
-longf4 = long4 + FLT_REG - REG_PAIR
-double8 = relative8 + regdef8 + regind8 + DBL_REG
-indexed2 = regind2 + reginddef2
-indexed4 = regind4
-indexed8 = regind8
-indexed = indexed2 + indexed4 + indexed8
-regdeferred = regdef2 + regdef4 + regdef8
-indordef = indexed + regdeferred
-locals = LOCAL2 + LOCAL4
-variable2 = relative2 + reldef2
-variable4 = relative4
-variable8 = relative8
-variable = variable2 + variable4 + variable8
-dadres2 = relative2 + REG + regind2
-regs = REG + REG_PAIR + FLT_REG + FLT_REG_PAIR +
- DBL_REG + DBL_REG_PAIR
-noconst2 = source2 - CONST2 - ADDR_EXTERNAL
-allexeptcon = all - regs - CONST2 - ADDR_LOCAL - ADDR_EXTERNAL
-externals = relative1 + relative2 + relative4 + relative8
-posextern = variable + regdeferred + indexed + externals
-diradr2 = regconst2 + ADDR_EXTERNAL
-
-#ifdef REGVARS
-#define INDSTORE remove(allexeptcon-locals) remove(locals, inreg(%[ind])==0)
-#else
-#define INDSTORE remove(allexeptcon)
-#endif
-
-CODE:
-
-/********************************************************
- * Group 1 : load instructions. *
- * *
- * For most load instructions no code is generated. *
- * Action : put something on the fake-stack. *
- ********************************************************/
-
-loc | | | {CONST2, $1} | |
-ldc | | | {CONST2, loww(1)} {CONST2, highw(1)} | |
-#ifdef REGVARS
-lol inreg($1)==2| | | regvar($1) | |
-#endif
-lol | | | {LOCAL2, $1,2} | |
-loe | | | {relative2, $1} | |
-#ifdef REGVARS
-lil inreg($1)==2| | | {regdef2, regvar($1)} | |
-#endif
-lil | | | {reginddef2, lb, tostring($1)} | |
-lof | REG | | {regind2,%[1],tostring($1)} | |
-... | NC regconst2 |
- | {regind2,%[1.reg],tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {relative2,tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {LOCAL2, %[1.ind] + $1,2} | |
-#ifdef REGVARS
-lol lof inreg($1)!=2 | |
- allocate(REG={LOCAL2, $1,2})
- | {regind2,%[a],tostring($2)} | |
-#endif
-lal | | | {ADDR_LOCAL, $1} | |
-lae | | | {ADDR_EXTERNAL, $1} | |
-lpb | | | | adp SL |
-lxl $1==0 | | | lb | |
-lxl $1==1 | | | {LOCAL2 ,SL,2} | |
-lxl $1==2 | | allocate(REG={LOCAL2, SL, 2})
- | {regind2,%[a], SSL} | |
-lxl $1==3 | | allocate(REG={LOCAL2, SL, 2})
- move({regind2,%[a], SSL},%[a])
- | {regind2,%[a], SSL} | |
-lxl $1>3 | | allocate(REG={LOCAL2, SL, 2}, REG={CONST2,$1-1})
- "1:"
- move({regind2,%[a], SSL},%[a])
- "sob %[b],1b"
- setcc(%[a]) erase(%[a]) erase(%[b])
- | %[a] | |
-lxa $1==0 | | | {ADDR_LOCAL, SL} | |
-lxa $1==1 | | allocate(REG={LOCAL2, SL, 2 })
- | {regconst2, %[a], SSL } | |
-lxa $1==2 | | allocate(REG={LOCAL2, SL, 2 })
- move({regind2, %[a], SSL }, %[a])
- | {regconst2, %[a], SSL } | |
-lxa $1==3 | | allocate(REG={LOCAL2, SL, 2 })
- move({regind2, %[a], SSL }, %[a])
- move({regind2, %[a], SSL }, %[a])
- | {regconst2, %[a], SSL } | |
-lxa $1 > 3 | | allocate(REG={LOCAL2, SL, 2}, REG={CONST2,$1-1})
- "1:"
- move({regind2,%[a], SSL},%[a])
- "sob %[b],1b"
- setcc(%[a]) erase(%[a]) erase(%[b])
- | {regconst2, %[a], SSL } | |
-dch | | | | loi 2 |
-loi $1==2 | REG | | {regdef2, %[1]} | |
-... | NC regconst2 | | {regind2, %[1.reg], %[1.ind]} | |
-... | NC relative2 | | {reldef2, %[1.ind]} | |
-... | NC regind2 | | {reginddef2, %[1.reg], %[1.ind]} | |
-... | NC regdef2 | | {reginddef2, %[1.reg], "0"}| |
-... | NC ADDR_LOCAL | | {LOCAL2, %[1.ind],2} | |
-... | NC ADDR_EXTERNAL | | {relative2, %[1.ind]} | |
-... | NC LOCAL2 |
- |{reginddef2, lb, tostring(%[1.ind])}| |
-loi $1==1 | REG | | {regdef1, %[1]} | |
-... | NC regconst2 | | {regind1, %[1.reg], %[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {relative1, %[1.ind]} | |
-... | NC ADDR_LOCAL| |{regind1, lb, tostring(%[1.ind])} | |
-... | NC relative2 | | {reldef1, %[1.ind]} | |
-... | NC regind2 | | {reginddef1, %[1.reg], %[1.ind]} | |
-... | NC regdef2 | | {reginddef1, %[1.reg], "0"}| |
-... | NC LOCAL2 | |{reginddef1, lb, tostring(%[1.ind])} | |
-loi $1==4 | REG | | {regdef4, %[1]} | |
-... | NC regconst2 | | {regind4, %[1.reg], %[1.ind]} | |
-... | NC ADDR_LOCAL | | {LOCAL4,%[1.ind],4} | |
-... | NC ADDR_EXTERNAL | | {relative4, %[1.ind]} | |
-loi $1==8 | REG | | {regdef8, %[1]} | |
-... | NC regconst2 | | {regind8, %[1.reg], %[1.ind]} | |
-... | NC ADDR_LOCAL |
- | {regind8, lb , tostring(%[1.ind])} | |
-... | NC ADDR_EXTERNAL | | {relative8, %[1.ind]} | |
-loi | NC ADDR_LOCAL |
- remove(all)
- allocate(REG={CONST2,$1/2},REG)
- move(lb,%[b])
- "add $$%(%[1.ind]+$1%),%[b]"
- "1:\tmov -(%[b]),-(sp)"
- "sob %[a],1b"
- erase(%[a]) erase(%[b]) | | |
-... | NC ADDR_EXTERNAL |
- remove(all)
- allocate(REG={CONST2,$1/2},REG)
- "mov $$%[1.ind]+$1,%[b]"
- "1:\tmov -(%[b]),-(sp)"
- "sob %[a],1b"
- erase(%[a]) erase(%[b]) | | |
-... | SCR_REG |
- remove(all)
- allocate(REG={CONST2,$1})
- "add %[a],%[1]"
- "asr %[a]"
- "1:\tmov -(%[1]),-(sp)"
- "sob %[a],1b"
- erase(%[1]) erase(%[a]) | | |
-los $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,los2~" | | |
-los !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,los2~" | | |
-ldl | | | {LOCAL4, $1,4} | |
-lde | | | {relative4, $1} | |
-ldf | regconst2 |
- | {regind4,%[1.reg], tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {relative4, tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {LOCAL4, %[1.ind]+$1,4} | |
-lpi | | | {ADDR_EXTERNAL, $1} | |
-
-/****************************************************************
- * Group 2 : Store instructions. *
- * *
- * These instructions are likely to ruin the fake-stack. *
- * We don't expect many items on the fake-stack anyway *
- * because we seem to have evaluated an expression just now. *
- ****************************************************************/
-
-#ifdef REGVARS
-stl inreg($1)==2| xsource2 |
- remove(regvar($1))
- move(%[1],regvar($1)) | | |
-#endif
-stl | xsource2 |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- move(%[1],{LOCAL2,$1,2}) | | |
-ste | xsource2 |
- remove(posextern)
- move(%[1], {relative2, $1 }) | | |
-#ifdef REGVARS
-sil inreg($1)==2| xsource2 |
- INDSTORE
- move(%[1], {regdef2,regvar($1)}) | | |
-#endif
-sil | xsource2 |
- INDSTORE
- move(%[1], {reginddef2,lb,tostring($1)}) | | |
-stf | regconst2 xsource2 |
- INDSTORE
- move(%[2],{regind2,%[1.reg],tostring($1)+"+"+%[1.ind]}) | | |
-... | ADDR_EXTERNAL xsource2 |
- INDSTORE
- move(%[2],{relative2,tostring($1)+"+"+%[1.ind]})| | |
-#ifdef REGVARS
-lol stf inreg($1)!=2 | xsource2 |
- INDSTORE
- allocate(REG={LOCAL2, $1,2})
- move(%[1],{regind2,%[a],tostring($2)}) | | |
-sti $1==2 | REG xsource2 |
- INDSTORE
- move(%[2],{regdef2,%[1]}) | | |
-... | regconst2 xsource2 |
- INDSTORE
- move(%[2],{regind2,%[1.reg],%[1.ind]}) | | |
-... | ADDR_EXTERNAL xsource2 |
- INDSTORE
- move(%[2],{relative2,%[1.ind]}) | | |
-... | ADDR_LOCAL xsource2 |
- INDSTORE
- move(%[2],{LOCAL2, %[1.ind], 2}) | | |
-... | relative2 xsource2 |
- INDSTORE
- move(%[2],{reldef2,%[1.ind]}) | | |
-... | regind2 xsource2 |
- INDSTORE
- move(%[2],{reginddef2,%[1.reg],%[1.ind]}) | | |
-sti $1==1 | REG source1or2 |
- INDSTORE
- move(%[2],{regdef1,%[1]}) | | |
-... | NC regconst2 source1or2 |
- INDSTORE
- move(%[2],{regind1,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_EXTERNAL source1or2 |
- INDSTORE
- move(%[2],{relative1,%[1.ind]}) | | |
-... | NC ADDR_LOCAL source1or2 |
- INDSTORE
- move(%[2],{regind1, lb, tostring(%[1.ind])}) | | |
-... | NC relative2 source1or2 |
- INDSTORE
- move(%[2],{reldef1,%[1.ind]}) | | |
-... | NC regind2 source1or2 |
- INDSTORE
- move(%[2],{reginddef1,%[1.reg],%[1.ind]}) | | |
-sti $1==4 | NC dadres2 FLT_REG |
- INDSTORE
- "movfo %[2],*%[1]"
- samecc | | |
-... | NC dadres2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],*%[1]\nseti"
- samecc | | |
-... | NC regconst2 FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind](%[1.reg])"
- samecc | | |
-... | NC regconst2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind](%[1.reg])\nseti"
- samecc | | |
-... | NC ADDR_LOCAL FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind](r5)"
- samecc | | |
-... | NC ADDR_LOCAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind](r5)\nseti"
- samecc | | |
-... | NC ADDR_EXTERNAL FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind]"
- samecc | | |
-... | NC ADDR_EXTERNAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind]\nseti"
- samecc | | |
-... | REG source2 source2 |
- INDSTORE
- move(%[2],{regdef2,%[1]})
- move(%[3],{regind2,%[1],"2"}) | | |
-... | SCR_REG STACK |
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])"
- erase(%[1]) | | | (4,2040)
-sti $1==8 | NC dadres2 DBL_REG |
- INDSTORE
- "movf %[2],*%[1]"
- samecc | | |
-... | NC regconst2 DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind](%[1.reg])"
- samecc | | |
-... | NC ADDR_LOCAL DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind](r5)"
- samecc | | |
-... | NC ADDR_EXTERNAL DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind]"
- samecc | | |
-... | SCR_REG regind8 |
- INDSTORE
- "mov %[2.ind](%[2.reg]),(%[1])+"
- "mov 2+%[2.ind](%[2.reg]),(%[1])+"
- "mov 4+%[2.ind](%[2.reg]),(%[1])+"
- "mov 6+%[2.ind](%[2.reg]),(%[1])"
- erase(%[1]) | | |
-... | SCR_REG relative8 |
- INDSTORE
- allocate(REG={ADDR_EXTERNAL,%[2.ind]})
- "mov (%[a])+,(%[1])+"
- "mov (%[a])+,(%[1])+"
- "mov (%[a])+,(%[1])+"
- "mov (%[a]),(%[1])"
- erase(%[1]) erase(%[a]) | | |
-... | SCR_REG |
- remove(all)
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])"
- erase(%[1]) | | | (8,4080)
-sti | SCR_REG |
- remove(all)
- allocate(REG={CONST2,$1/2})
- "1:\tmov (sp)+,(%[1])+"
- "sob %[a],1b"
- erase(%[1]) erase(%[a]) | | | (8,1500+$1*825)
-lal sti $2>2 && $2<=8 | NC xsource2 | | %[1] | stl $1 lal $1+2 sti $2-2 |
-... | | | {ADDR_LOCAL,$1} | sti $2 |
-sts $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,sto2~"
- erase(r01) | | |
-sdl | NC FLT_REG |
- remove(indordef)
- remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
- move(%[1],{LOCAL4,$1,4}) | | |
-... | NC ftolong |
- remove(indordef)
- remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
- "setl\nmovfi %[1.reg],$1(r5)\nseti"
- samecc | | |
-... | source2 source2 |
- remove(indordef)
- remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
- move(%[1],{LOCAL2,$1,2})
- move(%[2],{LOCAL2,$1+2,2}) | | |
-sde | NC FLT_REG |
- remove(posextern)
- move(%[1],{relative4,$1}) | | |
-... | NC ftolong |
- remove(posextern)
- "setl\nmovfi %[1.reg],$1\nseti"
- samecc | | |
-... | source2 source2 |
- remove(posextern)
- move(%[1], {relative2, $1 })
- move(%[2], {relative2, $1+"+2" }) | | |
-sdf | NC regconst2 FLT_REG |
- INDSTORE
- move(%[2],{regind4,%[1.reg],tostring($1)+"+"+%[1.ind]}) | | |
-... | NC regconst2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],$1+%[1.ind](%[1.reg])\nseti"
- samecc | | |
-... | NC ADDR_EXTERNAL FLT_REG |
- INDSTORE
- move(%[2],{relative4,tostring($1)+"+"+%[1.ind]})| | |
-... | NC ADDR_EXTERNAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],$1+%[1.ind]\nseti"
- samecc | | |
-... | regconst2 source2 source2 |
- INDSTORE
- move(%[2],{regind2,%[1.reg],tostring($1)+"+"+%[1.ind]})
- move(%[3],{regind2,%[1.reg],tostring($1+2)+"+"+%[1.ind]}) | | |
-... | ADDR_EXTERNAL source2 source2 |
- INDSTORE
- move(%[2],{relative2,tostring($1)+"+"+%[1.ind]})
- move(%[3],{relative2,tostring($1+2)+"+"+%[1.ind]}) | | |
-
-/****************************************************************
- * Group 3 : Integer arithmetic. *
- * *
- * Implemented (sometimes with the use of subroutines) : *
- * all 2 and 4 byte arithmetic. *
- ****************************************************************/
-
-adi $1==2 | NC SCR_REG CONST2 | | {regconst2,%[1],tostring(%[2.num])} | |
-... | NC SCR_REG ADDR_EXTERNAL | | {regconst2,%[1],%[2.ind]} | |
-... | NC SCR_REG ADDR_LOCAL |
- "add r5,%[1]" erase(%[1]) |
- {regconst2,%[1],tostring(%[2.ind])} | | (2,450)
-... | NC REG ADDR_LOCAL |
- allocate(REG)
- "mov r5,%[a]"
- "add %[1],%[a]"
- erase(%[a]) | {regconst2,%[a],tostring(%[2.ind])} | | (4,900)
-... | NC SCR_REG regconst2 |
- "add %[2.reg],%[1]" erase(%[1]) |
- {regconst2,%[1],%[2.ind]} | | (2,450)
-... | NC source2-REG CONST2+ADDR_EXTERNAL+ADDR_LOCAL |
- allocate(%[1],REG=%[1]) | %[2] %[a] | adi 2 |
-... | NC regconst2 CONST2 | |
- {regconst2,%[1.reg],
- tostring(%[2.num])+"+"+%[1.ind]} | |
-... | NC regconst2 ADDR_EXTERNAL | |
- {regconst2,%[1.reg],
- %[2.ind]+"+"+%[1.ind]} | |
-... | NC regconst2 ADDR_LOCAL |
- "add r5,%[1.reg]" erase(%[1.reg]) |
- {regconst2,%[1.reg],
- tostring(%[2.ind])+"+"+%[1.ind]} | | (2,450)
-... | NC regconst2 regconst2 |
- "add %[2.reg],%[1.reg]" erase(%[1.reg]) |
- {regconst2,%[1.reg],%[2.ind]+"+"+%[1.ind]} | | (2,450)
-... | NC regconst2 noconst2 |
- "add %[2],%[1.reg]" erase(%[1.reg]) | %[1] | | (2,450)+%[2]
-... | NC SCR_REG noconst2 |
- "add %[2],%[1]"
- setcc(%[1]) erase(%[1]) | %[1] | | (2,450)+%[2]
-... | NC source2 regconst2 |
- "add %[1],%[2.reg]"
- erase(%[2.reg]) | %[2] | | (2,450)+%[1]
-... | NC regconst2 source2 |
- "add %[2],%[1.reg]"
- erase(%[1.reg]) | %[1] | | (2,450)+%[2]
-... | source2 SCR_REG |
- "add %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | | (2,450)+%[1]
-adi $1==4 | SCR_REG SCR_REG source2 source2 |
- "add %[4],%[2]"
- "adc %[1]"
- "add %[3],%[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,1200)+%[4]+%[3]
-... | SCR_REG SCR_REG source2 STACK |
- "add (sp)+,%[2]"
- "adc %[1]"
- "add %[3],%[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,1900)+%[3]
-... | SCR_REG SCR_REG STACK |
- "add (sp)+,%[1]"
- "add (sp)+,%[2]"
- "adc %[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,2800)
-... | source2 source2 SCR_REG SCR_REG |
- "add %[2],%[4]"
- "adc %[3]"
- "add %[1],%[3]"
- setcc(%[3]) erase(%[3]) erase(%[4])
- | %[4] %[3] | | (6,1200)+%[1]+%[2]
-adi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,adi~" | | |
-sbi $1==2 | source2 SCR_REG |
- "sub %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | | (2,450)+%[1]
-... | NC SCR_REG source2-REG |
- "sub %[2],%[1]"
- "neg %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | | (4,750)+%[2]
-sbi $1==4 | source2-REG source2-REG SCR_REG SCR_REG |
- "sub %[2],%[4]"
- "sbc %[3]"
- "sub %[1],%[3]"
- setcc(%[3]) erase(%[3]) erase(%[4])
- | %[4] %[3] | | (6,1200)+%[1]+%[2]
-... | source2 source2 STACK |
- "sub %[2],2(sp)"
- "sbc (sp)"
- "sub %[1],(sp)" | | | (10,2800)+%[1]+%[2]
-sbi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sbi~" | | |
-mli $1==2 | SCR_ODD_REG source2 |
- "mul %[2],%[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |(2,3300)+%[2]
-... | source2 SCR_ODD_REG |
- "mul %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | |(2,3300)+%[1]
-mli $1==4 | | remove(all)
- "jsr pc,mli4~"
- | r1 r0 | |
-mli !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,mli~" | | |
-dvi $1==2 | source2 source2 |
- allocate(%[2],REG_PAIR)
- "mov %[2],%[a.2]"
- "sxt %[a.1]"
- "div %[1],%[a.1]" | %[a.1] | |
-... | source2 source2 |
- INDSTORE
- "mov %[1],-(sp)"
- "mov %[2],r1"
- "sxt r0"
- "div (sp)+,r0" | r0 | |(100,10000)
-dvi $1==4 | | remove(all)
- "jsr pc,dvi4~" | r1 r0 | |
-dvi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dvi~" | | |
-rmi $1==2 | source2 source2 |
- allocate(%[2],REG_PAIR)
- "mov %[2],%[a.2]"
- "sxt %[a.1]"
- "div %[1],%[a.1]" | %[a.2] | |
-... | source2 source2 |
- INDSTORE
- "mov %[1],-(sp)"
- "mov %[2],r1"
- "sxt r0"
- "div (sp)+,r0" | r1 | |(100,10000)
-rmi $1==4 | | remove(all)
- "jsr pc,rmi4~" | r1 r0 | |
-rmi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rmi~" | | |
-ngi $1==2 | SCR_REG |
- "neg %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | | (2,750)
-ngi $1==4 | SCR_REG SCR_REG |
- "neg %[1]"
- "neg %[2]"
- "sbc %[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,1800)
-ngi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,ngi~" | | |
-loc sli $1==1 && $2==2 | SCR_REG |
- "asl %[1]"
- setcc(%[1]) erase(%[1]) | %[1]| |
-sli $1==2 | source2 SCR_REG |
- "ash %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | |
-sli $1==4 | source2 SCR_REG_PAIR |
- "ashc %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | |
-sli !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sli~" | | |
-loc sri $1==1 && $2==2 | SCR_REG |
- "asr %[1]"
- setcc(%[1]) erase(%[1]) | %[1]| |
-loc sri $2==2 | SCR_REG |
- "ash $$%(0-$1%),%[1]"
- setcc(%[1]) erase(%[1]) | %[1]| |
-sri $1==2 | SCR_REG SCR_REG |
- "neg %[1]"
- "ash %[1], %[2]"
- setcc(%[2]) erase(%[1]) erase(%[2]) | %[2] | |
-loc sri $2==4 | SCR_REG_PAIR |
- "ashc $$%(0-$1%),%[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |
-sri $1==4 | SCR_REG SCR_REG_PAIR |
- "neg %[1]"
- "ashc %[1],%[2]"
- setcc(%[2]) erase(%[1]) erase(%[2]) | %[2] | |
-sri !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sri~" | | |
-
-/************************************************
- * Group 4 : unsigned arithmetic *
- * *
- * adu = adi *
- * sbu = sbi *
- * slu = sli *
- * *
- * Supported : 2- and 4 byte arithmetic. *
- ************************************************/
-
-adu | | | | adi $1 |
-sbu | | | | sbi $1 |
-mlu $1==2 | | | | mli $1 |
-mlu $1==4 | | remove(all)
- "jsr pc,mlu4~" | r1 r0 | |
-mlu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,mlu~" | | |
-dvu $1==2 | | remove(all)
- "jsr pc,dvu2~" | r0 | |
-dvu $1==4 | | remove(all)
- "jsr pc,dvu4~" | r1 r0 | |
-dvu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dvu~" | | |
-rmu $1==2 | | remove(all)
- "jsr pc,rmu2~" | r1 | |
-rmu $1==4 | | remove(all)
- "jsr pc,rmu4~" | r1 r0 | |
-rmu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rmu~" | | |
-slu | | | | sli $1 |
-sru $1==2 | SCR_REG xsource2 |
- allocate(%[2],REG_PAIR)
- move(%[2],%[a.2])
- move({CONST2,0},%[a.1])
- "neg %[1]"
- "ashc %[1],%[a]"
- erase(%[a]) | %[a.2] | |
-loc sru $2==2 | xsource2 |
- allocate(%[1],REG_PAIR)
- move(%[1],%[a.2])
- move({CONST2,0},%[a.1])
- "ashc $$%(0-$1%),%[a]"
- erase(%[a]) | %[a.2] | |
-sru $1==4 | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,sru~"
- erase(r0) | | |
-sru !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sru~" | | |
-
-/************************************************
- * Group 5 : Floating point arithmetic *
- * *
- * Supported : 4- and 8 byte arithmetic. *
- ************************************************/
-
-adf $1==4 | FLT_REG SCR_FLT_REG |
- "addf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,5000)+%[1]
-... | SCR_FLT_REG FLT_REG |
- "addf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,5000)+%[2]
-adf $1==8 | double8 SCR_DBL_REG |
- "addf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,6000)+%[1]
-... | SCR_DBL_REG double8 |
- "addf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,6000)+%[2]
-adf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,adf~" | | |
-sbf $1==4 | FLT_REG SCR_FLT_REG |
- "subf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,5000)+%[1]
-sbf $1==8 | double8 SCR_DBL_REG |
- "subf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,6000)+%[1]
-sbf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,sbf~" | | |
-mlf $1==4 | FLT_REG SCR_FLT_REG |
- "mulf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,7000)+%[1]
-... | SCR_FLT_REG FLT_REG |
- "mulf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,7000)+%[2]
-mlf $1==8 | double8 SCR_DBL_REG |
- "mulf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,10000)+%[1]
-... | SCR_DBL_REG double8 |
- "mulf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,10000)+%[2]
-mlf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,mlf~" | | |
-dvf $1==4 | FLT_REG SCR_FLT_REG |
- "divf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,8000)+%[1]
-dvf $1==8 | double8 SCR_DBL_REG |
- "divf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,12000)+%[1]
-dvf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,dvf~" | | |
-ngf $1==4 | SCR_FLT_REG |
- "negf %[1]"
- samecc erase(%[1]) | %[1] | |(2,2700)
-ngf $1==8 | SCR_DBL_REG |
- "negf %[1]"
- samecc erase(%[1]) | %[1] | |(2,2700)
-ngf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,ngf~" | | |
-fif $1==4 | longf4 FLT_REG |
- allocate(FLT_REG_PAIR)
- move(%[1],%[a.1])
- "modf %[2],%[a]"
- samecc erase(%[a.1]) | %[a.1] %[a.2] | | (2,7500)+%[2]
-fif $1==8 | double8 double8 |
- allocate(DBL_REG_PAIR)
- move(%[1],%[a.1])
- "modf %[2],%[a]"
- samecc erase(%[a.1]) | %[a.1] %[a.2] | | (2,15000)+%[2]
-fif !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,fif~" | | |
-fef $1==4 | FLT_REG |
- allocate(REG)
- "movei %[1],%[a]"
- "movie $$0,%[1]"
- samecc
- erase(%[1]) |%[1] %[a] | | (4,5000)
-fef $1==8 | DBL_REG |
- allocate(REG)
- "movei %[1],%[a]"
- "movie $$0,%[1]"
- samecc
- erase(%[1]) |%[1] %[a] | | (4,5000)
-fef !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,fef~" | | |
-
-/****************************************
- * Group 6 : pointer arithmetic. *
- * *
- * Pointers have size 2 bytes. *
- ****************************************/
-
-adp | SCR_REG | | {regconst2, %[1], tostring($1)} | |
-... | NC regconst2 | | {regconst2, %[1.reg], tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {ADDR_EXTERNAL, tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {ADDR_LOCAL,%[1.ind]+$1} | |
-ads $1==2 | | | | adi $1 |
-sbs $1==2 | | | | sbi $1 |
-
-/****************************************
- * Group 7 : increment/decrement/zero *
- ****************************************/
-
-inc | SCR_REG |
- "inc %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |
-#ifdef REGVARS
-inl inreg($1)==2| | remove(regvar($1))
- "inc %(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-inl | | remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "inc $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-ine | | remove(posextern)
- "inc $1"
- setcc({relative2,$1}) | | |
-dec | SCR_REG |
- "dec %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |
-#ifdef REGVARS
-del inreg($1)==2| | remove(regvar($1))
- "dec %(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-del | | remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "dec $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-dee | | remove(posextern)
- "dec $1"
- setcc({relative2,$1}) | | | (4,900)
-
-#ifdef REGVARS
-lol loc sbi stl $1==$4 && $3==2 && inreg($1)==2 | |
- remove(regvar($1))
- "sub $$$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol ngi stl $1==$3 && $2==2 && inreg($1)==2 | |
- remove(regvar($1))
- "neg %(regvar($1)%)"
- erase(regvar($1)) | | |
-lil ngi sil $1==$3 && $2==2 && inreg($1)==2 | |
- INDSTORE
- "neg *%(regvar($1)%)" | | |
-lil inc sil $1==$3 && inreg($1)==2 | | INDSTORE
- "inc *%(regvar($1)%)" | | |
-lol adi stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
- remove(regvar($1))
- "add %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adp stl $1==$3 && $2==1 && inreg($1)==2 | |
- remove(regvar($1))
- "inc %(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adp stl $1==$3 && inreg($1)==2 | |
- remove(regvar($1))
- "add $$$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-lol loc sbi stl $1==$4 && $3==2 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "sub $$$2,$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lol ngi stl $1==$3 && $2==2 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "neg $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lil ngi sil $1==$3 && $2==2 | | INDSTORE
- "neg *$1(r5)" | | |
-lil inc sil $1==$3 | | INDSTORE
- "inc *$1(r5)" | | |
-lol adi stl $2==2 && $1==$3 | source2 |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "add %[1],$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lol adp stl $1==$3 && $2==1 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "inc $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lol adp stl $1==$3 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "add $$$2,$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-loe adi ste $2==2 && $1==$3 | source2 |
- remove(posextern)
- "add %[1],$1"
- setcc({relative2,$1}) | | |
-loe adp ste $1==$3 | |
- remove(posextern)
- "add $$$2,$1"
- setcc({relative2,$1}) | | |
-#ifdef REGVARS
-lol ior stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
- remove(regvar($1))
- "bis %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-lol ior stl $2==2 && $1==$3 | source2 |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "bis %[1],$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-loe ior ste $2==2 && $1==$3 | source2 |
- remove(posextern)
- "bis %[1],$1"
- setcc({relative2,$1}) | | |
-#ifdef REGVARS
-lol and stl $2==2 && $1==$3 && inreg($1)==2 | SCR_REG |
- remove(regvar($1))
- "com %[1]"
- "bic %[1],%(regvar($1)%)"
- erase(%[1])
- erase(regvar($1)) | | |
-#endif
-lol and stl $2==2 && $1==$3 | SCR_REG |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "com %[1]"
- "bic %[1],$1(r5)"
- erase(%[1])
- setcc({LOCAL2,$1,2}) | | |
-loe and ste $2==2 && $1==$3 | SCR_REG |
- remove(posextern)
- "com %[1]"
- "bic %[1],$1"
- erase(%[1])
- setcc({relative2,$1}) | | |
-#ifdef REGVARS
-loc lol and stl $3==2 && $2==$4 && inreg($2)==2 | |
- remove(regvar($2))
- "bic $$%(~$1%),%(regvar($2)%)"
- erase(regvar($2)) | | |
-#endif
-loc lol and stl $3==2 && $2==$4 | |
- remove(indordef)
- remove(locals, %[ind] <= $2 && %[ind]+%[size] > $2)
- "bic $$%(~$1%),$2(r5)"
- setcc({LOCAL2,$2,2}) | | |
-loc loe and ste $3==2 && $2==$4 | |
- remove(posextern)
- "bic $$%(~$1%),$2"
- setcc({relative2,$2}) | | |
-#ifdef REGVARS
-zrl inreg($1)==2| | remove(regvar($1))
- "clr %(regvar($1)%)"
- erase(regvar($1)) | | | (4,900)
-#endif
-zrl | | remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "clr $1(r5)"
- setcc({LOCAL2,$1,2}) | | | (4,900)
-zre | | remove(posextern)
- "clr $1"
- setcc({relative2,$1}) | | | (4,900)
-zrf $1==4 | | allocate(FLT_REG)
- "clrf %[a]" | %[a] | | (2,2200)
-zrf $1==8 | | allocate(DBL_REG)
- "clrf %[a]" | %[a] | | (2,2400)
-zrf !defined($1)| | | | zer |
-zrf defined($1) | | | | zer $1 |
-zer $1==2 | | | {CONST2, 0} | |
-zer $1==4 | | | {CONST2,0} {CONST2,0} | |
-zer $1==6 | | | {CONST2,0} {CONST2,0}
- {CONST2,0} | |
-zer $1==8 | | | {CONST2,0} {CONST2,0}
- {CONST2, 0} {CONST2,0} | |
-zer defined($1) | | remove(all)
- move({CONST2,$1/2},r0)
- "1:\tclr -(sp)"
- "sob r0,1b"
- erase(r0) | | |(8,1500+$1*375)
-zer !defined($1)| SCR_REG |
- remove(all)
- "asr %[1]"
- "1:\tclr -(sp)"
- "sob %[1],1b"
- erase(%[1]) | | |
-
-/****************************************
- * Group 8 : Convert instructions *
- ****************************************/
-
-cii | | remove(all)
- " jsr pc,cii~" | | |
-cfi | | | | cfu |
-cfu | | remove(ALL)
- "jsr pc,cfi~" | | |
-cif | | remove(ALL)
- "jsr pc,cif~" | | |
-cuf | | remove(ALL)
- "jsr pc,cuf~" | | |
-cff | | remove(ALL)
- "jsr pc,cff~" | | |
-ciu | | | | cuu |
-cui | | | | cuu |
-cuu | | remove(all)
- "jsr pc,cuu~" | | |
-loc loc cii $1==1 && $2==2 | source1or2 |
- allocate(%[1],REG)
- "movb %[1],%[a]"
- /* movb does sign extend if dest is register */
- | %[a] | |
-loc loc cii $1==1 && $2==4 | source1or2 |
- allocate(%[1],REG,REG)
- "movb %[1],%[a]"
- "sxt %[b]"
- | %[a] %[b] | |
-loc loc cii $1==2 && $2==4 | source2 |
- allocate(%[1],REG,REG)
- move(%[1],%[a])
- test(%[a])
- "sxt %[b]"
- | %[a] %[b] | |
-loc loc loc cii $1>=0 && $2==2 && $3==4 | | | | loc $1 loc 0 |
-loc loc loc cii $1< 0 && $2==2 && $3==4 | | | | loc $1 loc 0-1 |
-loc loc cii $1==4 && $2==2 | source2 source2 | | %[2] | |
-loc loc cuu $1==2 && $2==4 | | | {CONST2,0} | |
-loc loc cuu $1==4 && $2==2 | source2 | | | |
-loc loc cfi | | | | loc $1 loc $2 cfu |
-loc loc cfu $1==4 && $2==2 | FLT_REG | | {ftoint,%[1]} | |
-loc loc cfu $1==4 && $2==4 | FLT_REG | | {ftolong,%[1]} | |
-loc loc cfu $1==8 && $2==2 | DBL_REG | | {ftoint,%[1]} | |
-loc loc cfu $1==8 && $2==4 | DBL_REG | | {ftolong,%[1]} | |
-loc loc cif $1==2 && $2==4 | source2 |
- allocate(FLT_REG)
- "movif %[1],%[a]"
- samecc
- | %[a] | |
-loc loc cif $1==2 && $2==8 | source2 |
- allocate(DBL_REG)
- "movif %[1],%[a]"
- samecc
- | %[a] | |
-loc loc cif $1==4 && $2==4 | NC long4-REG_PAIR |
- allocate(FLT_REG)
- "setl"
- "movif %[1],%[a]"
- "seti"
- samecc
- | %[a] | |
-... | | remove(all)
- allocate(FLT_REG)
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- samecc
- | %[a] | |
-loc loc cif $1==4 && $2==8 | NC long4-REG_PAIR |
- allocate(DBL_REG)
- "setl"
- "movif %[1],%[a]"
- "seti"
- samecc
- | %[a] | |
-... | | remove(all)
- allocate(DBL_REG)
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- samecc
- | %[a] | |
-loc loc cuf $1==2 && $2==4 | |
- remove(all)
- allocate(FLT_REG)
- "clr -(sp)"
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- | %[a] | |
-loc loc cuf $1==2 && $2==8 | |
- remove(all)
- allocate(DBL_REG)
- "clr -(sp)"
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- | %[a] | |
-loc loc cuf $1==4 && ($2==8 || $2==4) | | | | loc $1 loc $2 cif |
-loc loc cff $1==4 && $2==8 | longf4 - FLT_REG |
- allocate(DBL_REG)
- "movof %[1],%[a]"
- samecc
- | %[a] | |
-... | FLT_REG |
- allocate(DBL_REG)
- move(%[1],%[a.1])
- samecc | %[a] | |
-loc loc cff $1==8 && $2==4 | DBL_REG | | %[1.1] | |
-
-/****************************************
- * Group 9 : Logical instructions *
- ****************************************/
-
-and $1==2 | CONST2 SCR_REG |
- "bic $$%(~%[1.num]%),%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (4,750)
-... | SCR_REG CONST2 |
- "bic $$%(~%[2.num]%),%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (4,750)
-... | SCR_REG SCR_REG |
- "com %[1]"
- "bic %[1],%[2]"
- setcc(%[2])
- erase(%[1]) erase(%[2]) | %[2] | | (4,600)
-and defined($1) | | remove(all)
- move({CONST2,$1}, r0)
- "jsr pc,and~"
- erase(r0) | | |
-and !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,and~"
- erase(r0) | | |
-ior $1==2 | SCR_REG source2 |
- "bis %[2],%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,450)+%[2]
-... | source2 SCR_REG |
- "bis %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,450)+%[1]
-ior $1==8 | NC source2 source2 source2 source2 |
- remove(all)
- "bis %[1],(sp)"
- "bis %[2],2(sp)"
- "bis %[3],4(sp)"
- "bis %[4],6(sp)" | | |
-... | | remove(all)
- allocate(REG={CONST2,$1})
- "add sp,%[a]"
- "bis (sp)+,(%[a])+"
- "bis (sp)+,(%[a])+"
- "bis (sp)+,(%[a])+"
- "bis (sp)+,(%[a])+"
- erase(%[a]) | | |
-ior defined($1) | | remove(all)
- allocate(REG={CONST2,$1},REG={CONST2,$1/2})
- "add sp,%[a]"
- "1:\tbis (sp)+,(%[a])+"
- "sob %[b],1b"
- erase(%[a]) erase(%[b]) | | | (12,2100+$1*975)
-ior !defined($1)| SCR_REG |
- remove(all)
- allocate(REG=%[1])
- "asr %[1]"
- "add sp,%[a]"
- "1:\tbis (sp)+,(%[a])+"
- "sob %[1],1b"
- erase(%[1]) erase(%[a]) | | |
-xor $1==2 | REG SCR_REG |
- "xor %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,300)
-... | SCR_REG REG |
- "xor %[2],%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,300)
-xor defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,xor~"
- erase(r0) | | |
-xor !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,xor~"
- erase(r0) | | |
-com $1==2 | SCR_REG |
- "com %[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,300)
-com defined($1) | | remove(all)
- allocate(REG={CONST2,$1/2},REG)
- "mov sp,%[b]"
- "1:\tcom (%[b])+"
- "sob %[a],1b"
- erase(%[a]) | | | (10,1800+$1*825)
-com !defined($1)| SCR_REG |
- remove(all)
- allocate(REG)
- "asr %[1]"
- "mov sp,%[a]"
- "1:\tcom (%[a])+"
- "sob %[1],1b"
- erase(%[1]) | | |
-rol $1==2 | CONST2 SCR_ODD_REG |
- "ashc $$%(%[1.num]-16%),%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | SCR_REG SCR_ODD_REG |
- "sub $$16,%[1]"
- "ashc %[1],%[2]"
- setcc(%[2])
- erase(%[1]) erase(%[2]) | %[2] | |
-rol defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,rol~"
- erase(r0) | | |
-rol !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rol~"
- erase(r0) | | |
-ror $1==2 | CONST2 SCR_ODD_REG |
- "ashc $$%(0-%[1.num]%),%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | SCR_REG SCR_ODD_REG |
- "neg %[1]"
- "ashc %[1],%[2]"
- setcc(%[2]) erase(%[1]) erase(%[2]) | %[2] | |
-ror defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,ror~"
- erase(r0) | | |
-ror !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,ror~"
- erase(r0) | | |
-com and $1==2 && $2==2 | source2 SCR_REG |
- "bic %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,450)+%[1]
-com and $1==$2 | | remove(all)
- allocate(REG={CONST2,$1},REG)
- "mov sp,%[b]"
- "add %[a],%[b]"
- "asr %[a]"
- "1:\tbic (sp)+,(%[b])+"
- "sob %[a],1b"
- erase(%[a]) | | | (12,2100+$1*975)
-
-/********************************
- * Group 10 : Set instructions *
- ********************************/
-
-inn $1==2 | SCR_REG SCR_REG |
- "neg %[1]"
- "ash %[1],%[2]"
- "bic $$177776,%[2]"
- erase(%[1]) erase(%[2]) | %[2] | |
-loc inn $2==2 && $1==0 | SCR_REG |
- "bic $$177776,%[1]"
- erase(%[1]) | %[1] | |
-loc inn $2==2 && $1==1 | SCR_REG |
- "asr %[1]"
- "bic $$177776,%[1]"
- erase(%[1]) | %[1] | |
-loc inn $2==2 | SCR_REG |
- "ash $$%(0-$1%),%[1]"
- "bic $$177776,%[1]"
- erase(%[1]) | %[1] | |
-
-loc inn zeq $2==2 | | | {CONST2, 1<<$1} | and 2 zeq $3 |
-inn zeq $1==2 | source2 |
- allocate(REG={CONST2,1})
- "ash %[1],%[a]" | %[a] | and 2 zeq $2 |
-loc inn zne $2==2 | | | {CONST2, 1<<$1} | and 2 zne $3 |
-inn zne $1==2 | source2 |
- allocate(REG={CONST2,1})
- "ash %[1],%[a]" | %[a] | and 2 zne $2 |
-inn defined($1) | source2 |
- remove(all)
- move(%[1],r1)
- move({CONST2,$1},r0)
- "jsr pc,inn~"
- erase(r01) | r0 | |
-inn !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "mov (sp)+,r1"
- "jsr pc,inn~"
- erase(r01) | r0 | |
-set $1==2 | REG |
- allocate(REG={CONST2,1})
- "ash %[1],%[a]"
- erase(%[a]) | %[a] | |
-set defined($1) | source2 |
- remove(all)
- move(%[1],r1)
- move({CONST2,$1},r0)
- "jsr pc,set~"
- erase(r01) | | |
-set !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "mov (sp)+,r1"
- "jsr pc,set~"
- erase(r01) | | |
-
-/****************************************
- * Group 11 : Array instructions *
- ****************************************/
-
-lae aar $2==2 && rom(1,3)==1 && rom(1,1)==0 | | | | adi 2 |
-lae aar $2==2 && rom(1,3)==1 && rom(1,1)!=0 | | | | adi 2 adp 0-rom(1,1) |
-
-lae aar $2==2 && rom(1,3)==2 && rom(1,1)==0 | SCR_REG |
- "asl %[1]"
- erase(%[1]) | %[1] | adi 2 |
-lae aar $2==2 && rom(1,3)==2 && rom(1,1)!=0 | SCR_REG |
- "asl %[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-2)*rom(1,1))} |
- adi 2 |
-lae aar $2==2 && rom(1,3)==4 && rom(1,1)==0 | SCR_REG |
- "ash $$2,%[1]"
- erase(%[1]) |
- %[1] |
- adi 2 |
-lae aar $2==2 && rom(1,3)==4 && rom(1,1)!=0 | SCR_REG |
- "ash $$2,%[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-4)*rom(1,1))} |
- adi 2 |
-lae aar $2==2 && rom(1,3)==8 && rom(1,1)==0 | SCR_REG |
- "ash $$3,%[1]"
- erase(%[1]) |
- %[1] |
- adi 2 |
-lae aar $2==2 && rom(1,3)==8 && rom(1,1)!=0 | SCR_REG |
- "ash $$3,%[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-8)*rom(1,1))} |
- adi 2 |
-lae aar $2==2 && rom(1,1)==0 | SCR_ODD_REG |
- "mul $$%(rom(1,3)%),%[1]"
- erase(%[1]) |
- %[1] |
- adi 2 |
-lae aar $2==2 && defined(rom(1,1)) | SCR_ODD_REG |
- "mul $$%(rom(1,3)%),%[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-rom(1,3))*rom(1,1))} |
- adi 2 |
-aar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,aar~"
- erase(r01) | | |
-aar !defined($1) | | remove(all)
- "jsr pc,iaar~" | | |
-lae sar defined(rom(1,3)) | | | | lae $1 aar $2 sti rom(1,3) |
-lae lar defined(rom(1,3)) | | | | lae $1 aar $2 loi rom(1,3) |
-sar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,sar~"
- erase(r01) | | |
-sar !defined($1) | | remove(all)
- "jsr pc,isar~" | | |
-lar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,lar~"
- erase(r01) | | |
-lar !defined($1) | | remove(all)
- "jsr pc,ilar~" | | |
-
-/****************************************
- * group 12 : Compare instructions *
- ****************************************/
-
-cmi $1==2 | source2 SCR_REG |
- "sub %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | SCR_REG source2 |
- "sub %[2],%[1]"
- "neg %[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | |
-cmi $1==4 | | remove(all)
- "jsr pc,cmi4~" | r0 | |
-cmi !defined($1) | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cmi~"
- erase(r0) | r0 | |
-cmf defined($1) | | remove(ALL)
- move({CONST2,$1},r0)
- "jsr pc,cmf~"
- erase(r0) | r0 | |
-cmf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,cmf~"
- erase(r0) | r0 | |
-cmu $1==2 | | | | cmp |
-cmu $1==4 | | remove(all)
- "jsr pc,cmu4~" | r0 | |
-cmu defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,cmu~" | r0 | |
-cmu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cmu~"
- erase(r0) | r0 | |
-cms $1==2 | | | | cmi $1 |
-cms defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,cms~"
- erase(r0) | r0 | |
-cms !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cms~"
- erase(r0) | r0 | |
-cmp | source2 source2 |
- allocate(REG = {CONST2,0})
- "cmp %[1],%[2]"
- "beq 2f"
- "bhi 1f"
- "inc %[a]"
- "br 2f"
- "1:\tdec %[a]\n2:"
- setcc(%[a])
- erase(%[a]) | %[a] | |
-tlt and $2==2 | source2 SCR_REG |
- test(%[1])
- "blt 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tlt ior $2==2 | source2 SCR_REG |
- test(%[1])
- "bge 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tlt | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tle and $2==2 | source2 SCR_REG |
- test(%[1])
- "ble 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tle ior $2==2 | source2 SCR_REG |
- test(%[1])
- "bgt 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tle | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-teq and $2==2 | source1or2 SCR_REG |
- test(%[1])
- "beq 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-teq ior $2==2 | source1or2 SCR_REG |
- test(%[1])
- "bne 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-teq | source1or2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tne and $2==2 | source1or2 SCR_REG |
- test(%[1])
- "bne 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tne ior $2==2 | source1or2 SCR_REG |
- test(%[1])
- "beq 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tne | source1or2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tgt and $2==2 | source2 SCR_REG |
- test(%[1])
- "bgt 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tgt ior $2==2 | source2 SCR_REG |
- test(%[1])
- "ble 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tgt | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tge and $2==2 | source2 SCR_REG |
- test(%[1])
- "bge 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tge ior $2==2 | source2 SCR_REG |
- test(%[1])
- "blt 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tge | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-and tne $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "bit %[1],%[2]"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-and teq $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "bit %[1],%[2]"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-
-cmi tlt and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "blt 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tlt ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bge 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tlt $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmi tle and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "ble 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tle ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bgt 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tle $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmi teq and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "beq 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi teq ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bne 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi teq $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-loc cmi teq and $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "beq 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 teq and 2 |
-loc cmi teq ior $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "bne 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 teq ior 2 |
-loc cmi teq $1>=0 && $1<=127 && $2==2 | NC source1 |
- allocate(REG={CONST2,0})
- "cmpb %[1],$$$1"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | | | {CONST2, $1} | cmi 2 teq |
-cmi tne and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bne 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tne ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "beq 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tne $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-loc cmi tne and $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "bne 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 tne and 2 |
-loc cmi tne ior $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "beq 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 tne ior 2 |
-loc cmi tne $1>=0 && $1<=127 && $2==2 | NC source1 |
- allocate(REG={CONST2,0})
- "cmpb %[1],$$$1"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | | | {CONST2, $1} | cmi 2 tne |
-cmi tge and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bge 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tge ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "blt 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tge $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmi tgt and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bgt 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tgt ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "ble 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tgt $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tlt | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bhis 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tle | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bhi 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp teq | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tne | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tge | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "blo 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tgt | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "blos 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tlt $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tle $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf teq $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tne $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tgt $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tge $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tlt $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tle $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf teq $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tne $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tgt $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tge $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-
-/****************************************
- * Group 13 : Branch instructions *
- ****************************************/
-
-bra | | remove(all)
- "jbr $1"
- samecc | | |
-blt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jlt $1" | | |
-ble | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jle $1" | | |
-beq | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jeq $1" | | |
-bne | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jne $1" | | |
-bge | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jge $1" | | |
-bgt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jgt $1" | | |
-loc beq $1>=0 && $1<=127 | NC source1 |
- remove(all)
- "cmpb %[1],$$$1"
- "jeq $2" | | |
-... | | | {CONST2, $1} | beq $2 |
-loc bne $1>=0 && $1<=127 | NC source1 |
- remove(all)
- "cmpb %[1],$$$1"
- "jne $2" | | |
-... | | | {CONST2, $1} | bne $2 |
-zlt | source2 |
- remove(all)
- test(%[1])
- "jlt $1"
- samecc | | |
-zle | source2 |
- remove(all)
- test(%[1])
- "jle $1"
- samecc | | |
-zeq | source1or2 |
- remove(all)
- test(%[1])
- "jeq $1"
- samecc | | |
-zne | source1or2 |
- remove(all)
- test(%[1])
- "jne $1"
- samecc | | |
-zge | source2 |
- remove(all)
- test(%[1])
- "jge $1"
- samecc | | |
-zgt | source2 |
- remove(all)
- test(%[1])
- "jgt $1"
- samecc | | |
-cmp zlt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jlo $2" | | |
-cmp zle | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jlos $2" | | |
-cmp zeq | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jeq $2" | | |
-cmp zne | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jne $2" | | |
-cmp zgt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jhi $2" | | |
-cmp zge | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jhis $2" | | |
-cmf zlt $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jlt $2" | | |
-cmf zle $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jle $2" | | |
-cmf zeq $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jeq $2" | | |
-cmf zne $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jne $2" | | |
-cmf zgt $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jgt $2" | | |
-cmf zge $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jge $2" | | |
-cmf zlt $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jlt $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jgt $2" | | |
-cmf zle $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jle $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jge $2" | | |
-cmf zeq $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jeq $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jeq $2" | | |
-cmf zne $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jne $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jne $2" | | |
-cmf zgt $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jgt $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jlt $2" | | |
-cmf zge $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jge $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jle $2" | | |
-
-and zeq $1==2 | source2 source2 |
- remove(all)
- "bit %[1],%[2]"
- "jeq $2" | | |
-and zne $1==2 | source2 source2 |
- remove(all)
- "bit %[1],%[2]"
- "jne $2" | | |
-
-/************************************************
- * group 14 : Procedure call instructions *
- ************************************************/
-
-cal | | remove(ALL)
- "jsr pc,$1" | | |
-cai | REG | remove(ALL)
- "jsr pc,(%[1])" | | |
-lfr $1==2 | | | r0 | |
-lfr $1==4 | | | r1 r0 | |
-lfr $1==8 | | | {relative8,"retar"} | |
-lfr | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,lfr~"
- erase(r0) | | |
-
-lfr ret $1==$2 | | | | ret 0 |
-
-#ifndef REGVARS
-asp lfr ret $2==$3 | | | | ret 0 |
-asp ret $2==0 | | | | ret 0 |
-#endif
-
-ret $1==0 | | remove(all)
-#ifdef REGVARS
- return | | |
-#else
- "mov r5,sp\nmov (sp)+,r5\nrts pc" | | |
-#endif
-ret $1==2 | source2 |
- remove(all)
- move(%[1],r0)
-#ifdef REGVARS
- return | | |
-#else
- "mov r5,sp\nmov (sp)+,r5\nrts pc" | | |
-#endif
-ret $1==4 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
-#ifdef REGVARS
- return | | |
-#else
- "mov r5,sp\nmov (sp)+,r5\nrts pc" | | |
-#endif
-ret $1==8 | | | {ADDR_EXTERNAL, "retar"} | sti 8 ret 0 |
-ret | | remove(all)
- move({CONST2,$1},r0)
- "jmp ret~" | | |
-
-/************************************************
- * Group 15 : Miscellaneous instructions *
- ************************************************/
-
-asp $1==2 | | remove(all)
- "tst (sp)+" | | |
-asp $1==4 | | remove(all)
- "cmp (sp)+,(sp)+" | | |
-asp $1==0-2 | | remove(all)
- "tst -(sp)" | | |
-asp | | remove(all)
- "add $$$1,sp" | | |
-ass $1==2 | | remove(all)
- "add (sp)+,sp" | | |
-ass !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "add (sp)+,sp" | | |
-
-blm $1==4 | SCR_REG SCR_REG |
- "mov (%[2])+,(%[1])+"
- "mov (%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm $1==6 | SCR_REG SCR_REG |
- "mov (%[2])+,(%[1])+"
- "mov (%[2])+,(%[1])+"
- "mov (%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm $1==8 | SCR_REG SCR_REG |
- "mov (%[2])+,(%[1])+"
- "mov (%[2])+,(%[1])+"
- "mov (%[2])+,(%[1])+"
- "mov (%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm | SCR_REG SCR_REG |
- allocate(REG={CONST2,$1/2})
- "1:mov (%[2])+,(%[1])+\nsob %[a],1b"
- erase(%[1]) erase (%[2]) erase(%[a]) | | |
-bls $1==2 | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,blm~"
- erase(r01) | | |
-bls !defined($1)| source2 source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- move(%[2],r0)
- "jsr pc,blm~"
- erase(r01) | | |
-lae csa $2==2 | source2 |
- remove(all)
- move(%[1],r1)
- move({ADDR_EXTERNAL,$1},r0)
- "jmp csa~" | | |
-csa $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csa~" | | |
-csa !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csa~" | | |
-lae csb $2==2 | source2 |
- remove(all)
- move(%[1],r1)
- move({ADDR_EXTERNAL,$1},r0)
- "jmp csb~" | | |
-
-csb $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csb~" | | |
-csb !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csb~" | | |
-dup $1==2 | REG | | %[1] %[1] | |
-dup $1==4 | NC longf4 | | %[1] %[1] | |
-... | source2 source2 | | %[2] %[1] %[2] %[1] | |
-dup $1==8 | NC double8| | %[1] %[1] | |
-... | | remove(all)
- move({CONST2, $1}, r0)
- "jsr pc,dup~"
- erase(r01) | | |
-dup | | remove(all)
- move({CONST2, $1}, r0)
- "jsr pc,dup~"
- erase(r01) | | |
-dus $1==2 | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dup~"
- erase(r01) | | |
-dus !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "jsr pc,dup~"
- erase(r01) | | |
-gto | | remove(all)
- "mov $$$1,-(sp)"
- "jmp gto~" | | |
-fil | | "mov $$$1,hol0+4" | | |
-lim | | | { relative2, "trpim~"} | |
-lin | | "mov $$$1,hol0" | | |
-lni | | "inc hol0" | | |
-lor $1==0 | | | lb | |
-lor $1==1 | | remove(all)
- allocate(REG)
- "mov sp,%[a]" | %[a] | |
-lor $1==2 | | | {relative2,"reghp~"} | |
-mon | | remove(all)
- "jsr pc,mon~" | | |
-nop | | remove(all)
- "jsr pc,nop~" | | |
-#ifdef DORCK
-rck $1==2 | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rck~" | | |
-rck !defined($1)| source2 source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- move(%[2],r0)
- "jsr pc,rck~" | | |
-#else
-rck $1==2 | source2 | | | |
-rck !defined($1)| source2 source2 | | | |
-#endif
-rtt | | | | ret 0 |
-sig | source2 |
- allocate(REG)
- move({relative2,"trppc~"},%[a])
- "mov %[1],trppc~" | %[a] | |
-sim | | remove(all)
- "jsr pc,sim~" | | |
-str $1==0 | source2 |
- "mov %[1],r5" | | |
-str $1==1 | source2 |
- remove(all)
- "mov %[1],sp" | | |
-str $1==2 | | remove(all)
- "jsr pc,strhp~" | | |
-trp | | remove(all)
- "jsr pc,trp~" | | |
-exg $1==2 | source2 source2 | | %[1] %[2] | |
-exg defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,exg~" | | |
-exg | source2 | remove(all)
- move(%[1],r0)
- "jsr pc,exg" | | |
-
-lol lal sti $1==$2 && $3==1| | | | | /* throw away funny C-proc-prolog */
-
-/********************************
- * Coercions *
- * *
- * From EM-tokens to PDP-tokens *
- ********************************/
-
-| LOCAL2 | | {regind2,lb,tostring(%[1.ind])} | |
-| LOCAL4 | | {regind4,lb,tostring(%[1.ind])} | |
-
-/********************************
- * From source to register *
- ********************************/
-
-| regconst2 | allocate(%[1],REG=%[1.reg])
- "add $$%[1.ind],%[a]"
- setcc(%[a]) | %[a] | |(6,1050)
-| ADDR_LOCAL | allocate(REG)
- "mov r5,%[a]"
- "add $$%[1.ind],%[a]"
- setcc(%[a]) | %[a] | |(6,1050)
-| REG | | {regconst2, %[1], "0"} | | (2,600)
-| xsource2 | allocate(%[1], REG=%[1]) | %[a] | |
-| xsource2 | allocate(%[1], REG=%[1]) | {regconst2, %[a], "0"} | |
-| longf4 | allocate(FLT_REG)
- move( %[1],%[a]) | %[a] | | (20,20000) + %[1]
-| double8 | allocate(DBL_REG)
- move(%[1],%[a]) | %[a] | | (20,30000) + %[1]
-
-/********************************
- * From source1 to source2 *
- ********************************/
-
-| source1 | allocate(REG={CONST2,0})
- "bisb %[1],%[a]"
- erase(%[a]) setcc(%[a]) | %[a] | | (6,1050)+%[1]
-
-/********************************
- * From long4 to source2 *
- ********************************/
-
-| REG_PAIR | | %[1.2] %[1.1] | |
-| regind4 | | {regind2,%[1.reg],"2+"+%[1.ind]} {regind2,%[1.reg],%[1.ind]} | |
-| relative4 | | {relative2,"2+"+%[1.ind]} {relative2,%[1.ind]} | |
-| regdef4 | | {regind2,%[1.reg],"2"} {regdef2,%[1.reg]} | |
-| LOCAL4 | | {LOCAL2, %[1.ind]+2, 2} {LOCAL2, %[1.ind], 2} | |
-
-/********************************
- * from double8 to long4 *
- ********************************/
-
-| regind8 | | {regind4,%[1.reg],"4+"+%[1.ind]} {regind4,%[1.reg],%[1.ind]} | |
-| relative8 | | {relative4,"4+"+%[1.ind]} {relative4,%[1.ind]} | |
-| regdef8 | | {regdef4,%[1.reg]} {regind4,%[1.reg],"4"} | |
-
-
-
-/************************
- * From STACK coercions *
- ************************/
-
-| STACK | allocate(REG)
- "mov (sp)+,%[a]"
- setcc(%[a]) | %[a] | | (2,750)
-| STACK | allocate(REG)
- "mov (sp)+,%[a]"
- setcc(%[a]) | {regconst2, %[a], "0"} | | (2,750)
-| STACK | allocate(FLT_REG)
- "movof (sp)+,%[a]"
- samecc | %[a] | | (20,47400) /* /10 */
-| STACK | allocate(DBL_REG)
- "movf (sp)+,%[a]"
- samecc | %[a] | | (20,69200) /* /10 */
-| STACK | allocate(REG_PAIR)
- "mov (sp)+,%[a.1]"
- "mov (sp)+,%[a.2]"
- setcc(%[a.2]) | %[a] | | (4,1500)
-
-MOVES:
-(CONST2 %[num] == 0, source2, "clr %[2]" setcc(%[2]),(2,300))
-(source2, source2, "mov %[1],%[2]" setcc(%[2]),(2,300)+%[1]+%[2])
-(FLT_REG, longf4-FLT_REG,"movfo %[1],%[2]" samecc, (2,880) + %[2])
-(longf4-FLT_REG,FLT_REG, "movof %[1],%[2]" samecc, (2,1500) + %[2])
-(FLT_REG, FLT_REG, "movf %[1],%[2]" samecc,(2,880))
-(DBL_REG,double8, "movf %[1],%[2]" samecc,(2,880) + %[2])
-(double8,DBL_REG, "movf %[1],%[2]" samecc,(2,1700) + %[1])
-(CONST2 %[num] == 0,source1, "clrb %[2]" setcc(%[2]),(2,450)+%[2])
-(source1or2,source1, "movb %[1],%[2]" setcc(%[2]),(2,300)+%[1]+%[2])
-(ftoint,source2, "movfi %[1.reg],%[2]" samecc)
-
-TESTS:
-(source2, "tst %[1]" ,(2,300) + %[1])
-(source1, "tstb %[1]",(2,400) + %[1])
-(FLT_REG+DBL_REG, "tstf %[1]\ncfcc" ,(4,2600))
-/* (DBL_REG, "tstf %[1]\ncfcc" ,(4,2600)) */
-
-STACKS:
-( CONST2 %[num]==0 ,, "clr -(sp)" )
-( source2 ,, "mov %[1],-(sp)" setcc(%[1]), (2,900)+%[1])
-( regconst2 ,, "mov %[1.reg],-(sp)\nadd $$%[1.ind],(sp)" , (6,2250))
-( ADDR_LOCAL,, "mov r5,-(sp)" "add $$%[1.ind],(sp)", (6,2250))
-( DBL_REG ,, "movf %[1],-(sp)" samecc , (2,6100))
-( FLT_REG ,, "movfo %[1],-(sp)" samecc , (2,4120))
-( REG_PAIR ,, "mov %[1.2],-(sp)" "mov %[1.1],-(sp)" , (4,1800))
-( regind4 ,, "mov 2+%[1.ind](%[1.reg]),-(sp)"
- "mov %[1.ind](%[1.reg]),-(sp)" , (8,3000))
-( relative4 ,, "mov 2+%[1.ind],-(sp)"
- "mov %[1.ind],-(sp)" , (8,3000))
-( regdef4 ,, "mov 2(%[1.reg]),-(sp)"
- "mov (%[1.reg]),-(sp)" , (6,2700))
-( regind8 ,REG, move(%[1.reg],%[a])
- "add $$%(8%)+%[1.ind],%[a]"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- erase(%[a]) , (14,6000))
-( regind8 ,, "mov 6+%[1.ind](%[1.reg]),-(sp)"
- "mov 4+%[1.ind](%[1.reg]),-(sp)"
- "mov 2+%[1.ind](%[1.reg]),-(sp)"
- "mov %[1.ind](%[1.reg]),-(sp)" , (16,6000))
-( relative8 ,REG,"mov $$%(8%)+%[1.ind],%[a]"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)" , (12,5000))
-( relative8 ,, "mov 6+%[1.ind],-(sp)"
- "mov 4+%[1.ind],-(sp)"
- "mov 2+%[1.ind],-(sp)"
- "mov %[1.ind],-(sp)" , (16,6000))
-( regdef8 ,, "mov 6(%[1.reg]),-(sp)"
- "mov 4(%[1.reg]),-(sp)"
- "mov 2(%[1.reg]),-(sp)"
- "mov (%[1.reg]),-(sp)" , (14,5700))
-( LOCAL4 ,, "mov 2+%[1.ind](r5),-(sp)"
- "mov %[1.ind](r5),-(sp)" , (8,3000))
-( source1 ,, "clr -(sp)"
- "movb %[1],(sp)" , (4,1800)+%[1])
-( ftoint ,, "movfi %[1.reg],-(sp)" )
-( ftolong ,, "setl\nmovfi %[1.reg],-(sp)\nseti" )
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-/* $Header$ */
-
-#ifndef NDEBUG
-#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__)
-#else
-#define assert(x) /* nothing */
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "state.h"
-#include "equiv.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define SHORTCUT /* Stop searching at distance 0 */
-
-#if NREGS >= MAXRULE
-#define MAXPOS NREGS
-#else
-#define MAXPOS MAXRULE
-#endif
-
-#define MAXPATTERN 5
-#define MAXREPLLEN 5 /* Max length of EM-replacement, should come from boot */
-
-byte startupcode[] = { DO_NEXTEM };
-
-byte *nextem();
-unsigned costcalc();
-unsigned docoerc();
-unsigned stackupto();
-string tostring();
-
-#ifdef NDEBUG
-#define DEBUG()
-#else
-#include <stdio.h>
-#define DEBUG(string) {if(Debug) fprintf(stderr,"%-*d%s\n",4*level,level,string);}
-#endif
-
-#define BROKE() {assert(origcp!=startupcode);DEBUG("BROKE");goto doreturn;}
-#define CHKCOST() {if (totalcost>=costlimit) BROKE();}
-
-unsigned codegen(codep,ply,toplevel,costlimit,forced) byte *codep; unsigned costlimit; {
-#ifndef NDEBUG
- byte *origcp=codep;
- static int level=0;
-#endif
- unsigned totalcost = 0;
- byte *bp;
- int n;
- unsigned mindistance,dist;
- register i;
- int cindex;
- int npos,npos2,pos[MAXPOS],pos2[MAXPOS];
-#ifdef STONSTACK
- state_t state;
-#define SAVEST savestatus(&state)
-#define RESTST restorestatus(&state)
-#define FREEST /* nothing */
-#else
- state_p state;
-#define SAVEST state=savestatus()
-#define RESTST restorestatus(state)
-#define FREEST freestatus(state)
-#endif
- unsigned mincost,t;
- int texpno,nodeno;
- token_p tp;
- tkdef_p tdp;
- int tinstno;
- struct reginfo *rp,**rpp;
- token_t token,mtoken,token2;
- int propno;
- int exactmatch;
- int j;
- int decision;
- int stringno;
- result_t result;
- cost_t cost;
- int size,lsize,repllen;
- int tokexp[MAXPATTERN];
- int nregneeded;
- token_p regtp[MAXCREG];
- c3_p regcp[MAXCREG];
- rl_p regls[MAXCREG];
- c3_p cp,findcoerc();
- int sret;
- token_t reptoken[MAXREPLLEN];
- int emrepllen,eminstr;
- int inscoerc=0;
- int stackpad;
- struct perm *tup,*ntup,*besttup,*tuples();
-
-#ifndef NDEBUG
- level++;
- DEBUG("Entering codegen");
-#endif
- for (;;) {
- switch( (*codep++)&037 ) {
- default:
- assert(FALSE);
- /* NOTREACHED */
- case DO_NEXTEM:
- DEBUG("NEXTEM");
- tokpatlen = 0;
- nallreg=0;
- if (toplevel) {
- garbage_collect();
- totalcost=0;
- } else {
- if (--ply <= 0)
- goto doreturn;
- }
- if (stackheight>MAXFSTACK-7)
- totalcost += stackupto(&fakestack[6],ply,toplevel);
- bp = nextem(toplevel);
- if (bp == 0) {
- /*
- * No pattern found, can be pseudo or error
- * in table.
- */
- if (toplevel) {
- codep--;
- DEBUG("pseudo");
- dopseudo();
- } else
- goto doreturn;
- } else {
-#ifndef NDEBUG
- chkregs();
-#endif
- n = *bp++;
- assert(n>0 && n<=MAXRULE);
- if (n>1) {
- mindistance = MAXINT; npos=0;
- for(i=0;i<n;i++) {
- getint(cindex,bp);
- dist=distance(cindex);
-#ifndef NDEBUG
-if (Debug)
- fprintf(stderr,"distance of pos %d is %u\n",i,dist);
-#endif
- if (dist<=mindistance) {
- if (dist<mindistance) {
-#ifdef SHORTCUT
- if(dist==0)
- goto gotit;
-#endif
- npos=0;
- mindistance = dist;
- }
- pos[npos++] = cindex;
- }
- }
- assert(mindistance<MAXINT);
- if (npos>1) {
- /*
- * More than 1 tokenpattern is a candidate.
- * Decision has to be made by lookahead.
- */
- SAVEST;
- mincost = costlimit-totalcost+1;
- for(i=0;i<npos;i++) {
- t=codegen(&coderules[pos[i]],ply,FALSE,mincost,0);
-#ifndef NDEBUG
-if (Debug)
- fprintf(stderr,"mincost %u,cost %u,pos %d\n",mincost,t,i);
-#endif
- if (t<mincost) {
- mincost = t;
- cindex = pos[i];
- }
- RESTST;
- }
- FREEST;
- if (totalcost+mincost>costlimit) {
- totalcost += mincost;
- BROKE();
- }
- } else {
- cindex = pos[0];
- }
- } else {
- getint(cindex,bp);
- }
-
- gotit:
- /*
- * Now cindex contains the code-index of the best candidate
- * so proceed to use it.
- */
- codep = &coderules[cindex];
- }
- break;
- case DO_COERC:
- DEBUG("COERC");
- tokpatlen=1;
- inscoerc=1;
- break;
- case DO_XXMATCH:
- DEBUG("XXMATCH");
- case DO_XMATCH:
- DEBUG("XMATCH");
- tokpatlen=(codep[-1]>>5)&07;
- for (i=0;i<tokpatlen;i++)
- getint(tokexp[i],codep);
- tokexp[i]=0;
- break; /* match already checked by distance() */
- case DO_MATCH:
- DEBUG("MATCH");
- tokpatlen=(codep[-1]>>5)&07;
- for(i=0;i<tokpatlen;i++)
- getint(tokexp[i],codep);
- tokexp[i] = 0;
- tp = &fakestack[stackheight-1];
- i=0;
- while (i<tokpatlen && tp>=fakestack) {
- size=tsize(tp);
- while (i<tokpatlen && (lsize=ssize(tokexp[i]))<=size) {
- size -= lsize;
- i++;
- }
- if (i<tokpatlen && size!=0) {
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- }
- tp--;
- }
- tp = &fakestack[stackheight-1];
- i=0;
- while (i<tokpatlen && tp >= fakestack) {
- size = tsize(tp);
- lsize= ssize(tokexp[i]);
- if (size != lsize) { /* find coercion */
-#ifdef MAXSPLIT
- sret = split(tp,&tokexp[i],ply,toplevel);
- if (sret==0) {
-#endif MAXSPLIT
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
-#ifdef MAXSPLIT
- }
- i += sret;
-#endif MAXSPLIT
- } else
- i += 1;
- tp--;
- }
- nextmatch:
- tp = &fakestack[stackheight-1];
- i=0; nregneeded = 0;
- while (i<tokpatlen && tp>=fakestack) {
- if (!match(tp,&machsets[tokexp[i]],0)) {
- cp = findcoerc(tp, &machsets[tokexp[i]]);
- if (cp==0) {
- for (j=0;j<nregneeded;j++)
- regtp[j] -= (tp-fakestack+1);
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- } else {
- if (cp->c3_prop==0) {
- totalcost+=docoerc(tp,cp,ply,toplevel,0);
- CHKCOST();
- } else {
- assert(nregneeded<MAXCREG);
- regtp[nregneeded] = tp;
- regcp[nregneeded] = cp;
- regls[nregneeded] = curreglist;
- nregneeded++;
- }
- }
- }
- i++; tp--;
- }
- if (tokpatlen>stackheight) {
- stackpad = tokpatlen-stackheight;
- for (j=stackheight-1;j>=0;j--)
- fakestack[j+stackpad] = fakestack[j];
- for (j=0;j<stackpad;j++)
- fakestack[j].t_token=0;
- stackheight += stackpad;
- for (j=0;j<nregneeded;j++)
- regtp[j] += stackpad;
- tp = &fakestack[stackpad-1];
- while (i<tokpatlen && tp>=fakestack) {
- cp = findcoerc((token_p) 0, &machsets[tokexp[i]]);
- if (cp==0) {
- assert(!toplevel);
- for (j=0;j<nregneeded;j++)
- myfree(regls[j]);
- totalcost=INFINITY;
- BROKE();
- }
- if (cp->c3_prop==0) {
- totalcost+=docoerc(tp,cp,ply,toplevel,0);
- CHKCOST();
- } else {
- assert(nregneeded<MAXCREG);
- regtp[nregneeded] = tp;
- regcp[nregneeded] = cp;
- regls[nregneeded] = curreglist;
- nregneeded++;
- }
- i++; tp--;
- }
- } else
- stackpad=0;
- assert(i==tokpatlen);
- if (nregneeded==0)
- break;
- SAVEST;
- mincost=costlimit-totalcost+1;
- tup = tuples(regls,nregneeded);
- besttup=0;
- for (; tup != 0; tup = ntup) {
- ntup = tup->p_next;
- for (i=0,t=0;i<nregneeded && t<mincost; i++)
- t += docoerc(regtp[i],regcp[i],ply,FALSE,tup->p_rar[i]);
- if (t<mincost)
- t += codegen(codep,ply,FALSE,mincost-t,0);
- if (t<mincost) {
- mincost = t;
- besttup = tup;
- } else
- myfree(tup);
- RESTST;
- }
- FREEST;
- for (i=0;i<nregneeded;i++)
- myfree(regls[i]);
- if (totalcost+mincost>costlimit) {
- if (besttup)
- myfree(besttup);
- if (stackpad!=tokpatlen) {
- if (stackpad) {
- if (costlimit<MAXINT) {
- totalcost = costlimit+1;
- BROKE();
- }
- for (i=0;i<stackheight-stackpad;i++)
- fakestack[i] = fakestack[i+stackpad];
- stackheight -= stackpad;
- totalcost += stackupto(&fakestack[stackheight-1],ply,toplevel);
- } else
- totalcost += stackupto(fakestack,ply,toplevel);
- CHKCOST();
- goto nextmatch;
- }
- totalcost += mincost;
- BROKE();
- }
- for (i=0;i<nregneeded;i++)
- totalcost += docoerc(regtp[i],regcp[i],ply,toplevel,besttup->p_rar[i]);
- myfree(besttup);
- break;
- case DO_REMOVE:
- DEBUG("REMOVE");
- if (codep[-1]&32) {
- getint(texpno,codep);
- getint(nodeno,codep);
- } else {
- getint(texpno,codep);
- nodeno=0;
- }
- for (tp= &fakestack[stackheight-tokpatlen-1];tp>=&fakestack[0];tp--)
- if (match(tp,&machsets[texpno],nodeno)) {
- /* investigate possible coercion to register */
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- }
- for (rp=machregs+2;rp<machregs+NREGS;rp++)
- if (match(&rp->r_contents,&machsets[texpno],nodeno))
- rp->r_contents.t_token=0;
- break;
- case DO_RREMOVE: /* register remove */
- getint(nodeno,codep);
- result=compute(&enodes[nodeno]);
- assert(result.e_typ==EV_REG);
- for (tp= &fakestack[stackheight-tokpatlen-1];tp>=&fakestack[0];tp--)
- if (tp->t_token==-1) {
- if(tp->t_att[0].ar==result.e_v.e_con)
- goto gotone;
- } else {
- tdp = &tokens[tp->t_token];
- for(i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG &&
- tp->t_att[i].ar==result.e_v.e_con)
- goto gotone;
- }
- break;
- gotone:
- /* investigate possible coercion to register */
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- case DO_DEALLOCATE:
- DEBUG("DEALLOCATE");
- getint(tinstno,codep);
- instance(tinstno,&token);
- if (token.t_token==-1)
- chrefcount(token.t_att[0].ar,-1,TRUE);
- else {
- tdp= &tokens[token.t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG)
- chrefcount(token.t_att[i].ar,-1,TRUE);
- }
- break;
- case DO_REALLOCATE:
- DEBUG("REALLOCATE");
- for(rp=machregs;rp<machregs+NREGS;rp++)
- if(rp->r_tcount) {
- rp->r_refcount -= rp->r_tcount;
- rp->r_tcount = 0;
- }
- break;
- case DO_ALLOCATE:
- DEBUG("ALLOCATE");
- if (codep[-1]&32) {
- getint(propno,codep);
- getint(tinstno,codep);
- } else {
- getint(propno,codep);
- tinstno=0;
- }
- instance(tinstno,&token);
- if (!forced) {
- do {
- npos=exactmatch=0;
- for(rpp=reglist[propno];rp= *rpp; rpp++)
- if (getrefcount(rp-machregs)==0) {
- pos[npos++] = rp-machregs;
- if (eqtoken(&rp->r_contents,&token))
- exactmatch++;
- }
- /*
- * Now pos[] contains all free registers with desired
- * property. If none then some stacking has to take place.
- */
- if (npos==0) {
- if (stackheight<=tokpatlen) {
- if (!toplevel) {
- totalcost = INFINITY;
- BROKE();
- } else {
- fatal("No regs available");
- }
- }
- totalcost += stackupto( &fakestack[0],ply,toplevel);
- CHKCOST();
- }
- } while (npos==0);
- if (!exactmatch) {
- npos2=npos;
- for(i=0;i<npos;i++)
- pos2[i]=pos[i];
- } else {
- /*
- * Now we are reducing the number of possible registers.
- * We take only one equally likely register out of every
- * equivalence class as given by set of properties.
- */
- mtoken = token;
- npos2=0;
- for(i=0;i<npos;i++)
- if (eqtoken(&machregs[pos[i]].r_contents,&mtoken)) {
- pos2[npos2++] = pos[i];
- for(j=0;j<npos2-1;j++)
- if (eqregclass(pos2[j],pos[i])) {
- npos2--;
- break;
- }
- }
- }
- /*
- * Now pos2[] contains all possibilities to try, if more than
- * one, lookahead is necessary.
- */
- token2.t_token= -1;
- for (i=1;i<TOKENSIZE;i++)
- token2.t_att[i].aw=0;
- if (npos2==1)
- decision=pos2[0];
- else {
- SAVEST;
- mincost=costlimit-totalcost+1;
- for(j=0;j<npos2;j++) {
- chrefcount(pos2[j],1,FALSE);
- token2.t_att[0].ar=pos2[j];
- allreg[nallreg++] = pos2[j];
- if (token.t_token != 0)
- t=move(&token,&token2,ply,FALSE,mincost);
- else {
- t = 0;
- erasereg(pos2[j]);
- }
- if (t<mincost)
- t += codegen(codep,ply,FALSE,mincost-t,0);
- if (t<mincost) {
- mincost=t;
- decision=pos2[j];
- }
- RESTST;
- }
- FREEST;
- if (totalcost+mincost>costlimit) {
- totalcost = INFINITY;
- BROKE();
- }
- }
- } else {
- decision = forced;
- if (getrefcount(decision)!=0) {
- totalcost = INFINITY;
- BROKE();
- }
- token2.t_token = -1;
- }
- chrefcount(decision,1,FALSE);
- token2.t_att[0].ar=decision;
- if (token.t_token != 0) {
- totalcost+=move(&token,&token2,ply,toplevel,MAXINT);
- CHKCOST();
- } else
- erasereg(decision);
- allreg[nallreg++]=decision;
- break;
- case DO_LOUTPUT:
- DEBUG("LOUTPUT");
- getint(stringno,codep);
- getint(nodeno,codep);
- if (toplevel) {
- gencode(codestrings[stringno]);
- genexpr(nodeno);
- }
- break;
- case DO_ROUTPUT:
- DEBUG("ROUTPUT");
- i=((codep[-1]>>5)&07);
- do {
- getint(stringno,codep);
- if (toplevel) {
- gencode(codestrings[stringno]);
- gennl();
- }
- } while (i--);
- break;
- case DO_MOVE:
- DEBUG("MOVE");
- getint(tinstno,codep);
- instance(tinstno,&token);
- getint(tinstno,codep);
- instance(tinstno,&token2);
- totalcost += move(&token,&token2,ply,toplevel,costlimit-totalcost+1);
- CHKCOST();
- break;
- case DO_ERASE:
- DEBUG("ERASE");
- getint(nodeno,codep);
- result=compute(&enodes[nodeno]);
- assert(result.e_typ==EV_REG);
- erasereg(result.e_v.e_reg);
- break;
- case DO_TOKREPLACE:
- DEBUG("TOKREPLACE");
- assert(stackheight>=tokpatlen);
- repllen=(codep[-1]>>5)&07;
- for(i=0;i<repllen;i++) {
- getint(tinstno,codep);
- instance(tinstno,&reptoken[i]);
- tref(&reptoken[i],1);
- }
- for(i=0;i<tokpatlen;i++) {
- if (!inscoerc)
- tref(&fakestack[stackheight-1],-1);
- stackheight--;
- }
- for (i=0;i<repllen;i++) {
- assert(stackheight<MAXFSTACK);
- fakestack[stackheight++] = reptoken[i];
- }
- for(i=0;i<nallreg;i++)
- chrefcount(allreg[i],-1,FALSE);
- break;
- case DO_EMREPLACE:
- DEBUG("EMREPLACE");
- emrepllen=(codep[-1]>>5)&07;
- j=emp-emlines;
- if (emrepllen>j) {
- assert(nemlines+emrepllen-j<MAXEMLINES);
- for (i=nemlines;i>=0;i--)
- emlines[i+emrepllen-j] = emlines[i];
- nemlines += emrepllen-j;
- emp += emrepllen-j;
- }
- emp -= emrepllen;
- for (i=0;i<emrepllen;i++) {
- getint(eminstr,codep);
- getint(nodeno,codep);
- emp[i].em_instr = eminstr;
- result = compute(&enodes[nodeno]);
- switch(result.e_typ) {
- default:
- assert(FALSE);
- case 0:
- emp[i].em_optyp = OPNO;
- emp[i].em_soper = 0;
- break;
- case EV_INT:
- emp[i].em_optyp = OPINT;
- emp[i].em_soper = tostring(result.e_v.e_con);
- emp[i].em_u.em_ioper = result.e_v.e_con;
- break;
- case EV_STR:
- emp[i].em_optyp = OPSYMBOL;
- emp[i].em_soper = result.e_v.e_str;
- break;
- }
- }
- if (!toplevel)
- ply += emrepllen;
- break;
- case DO_COST:
- DEBUG("COST");
- getint(cost.c_size,codep);
- getint(cost.c_time,codep);
- totalcost += costcalc(cost);
- CHKCOST();
- break;
-#ifdef REGVARS
- case DO_PRETURN:
- if (toplevel) {
- swtxt();
- regreturn(); /* in mach.c */
- }
- break;
-#endif
- case DO_RETURN:
- DEBUG("RETURN");
- assert(origcp!=startupcode);
- doreturn:
-#ifndef NDEBUG
- level--;
-#endif
- return(totalcost);
- }
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "glosym.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define LLEAF 01
-#define LDEF 02
-#define RLEAF 04
-#define RDEF 010
-#define LLDEF LLEAF|LDEF
-#define RLDEF RLEAF|RDEF
-
-char opdesc[] = {
- 0, /* EX_TOKFIELD */
- 0, /* EX_ARG */
- 0, /* EX_CON */
- 0, /* EX_ALLREG */
- LLDEF|RLDEF, /* EX_SAMESIGN */
- LLDEF|RLDEF, /* EX_SFIT */
- LLDEF|RLDEF, /* EX_UFIT */
- 0, /* EX_ROM */
- LLDEF|RLDEF, /* EX_NCPEQ */
- LLDEF|RLDEF, /* EX_SCPEQ */
- LLDEF|RLDEF, /* EX_RCPEQ */
- LLDEF|RLDEF, /* EX_NCPNE */
- LLDEF|RLDEF, /* EX_SCPNE */
- LLDEF|RLDEF, /* EX_RCPNE */
- LLDEF|RLDEF, /* EX_NCPGT */
- LLDEF|RLDEF, /* EX_NCPGE */
- LLDEF|RLDEF, /* EX_NCPLT */
- LLDEF|RLDEF, /* EX_NCPLE */
- LLDEF, /* EX_OR2 */
- LLDEF, /* EX_AND2 */
- LLDEF|RLDEF, /* EX_PLUS */
- LLDEF|RLDEF, /* EX_CAT */
- LLDEF|RLDEF, /* EX_MINUS */
- LLDEF|RLDEF, /* EX_TIMES */
- LLDEF|RLDEF, /* EX_DIVIDE */
- LLDEF|RLDEF, /* EX_MOD */
- LLDEF|RLDEF, /* EX_LSHIFT */
- LLDEF|RLDEF, /* EX_RSHIFT */
- LLDEF, /* EX_NOT */
- LLDEF, /* EX_COMP */
- 0, /* EX_COST */
- 0, /* EX_STRING */
- LLEAF, /* EX_DEFINED */
- 0, /* EX_SUBREG */
- LLDEF, /* EX_TOSTRING */
- LLDEF, /* EX_UMINUS */
- 0, /* EX_REG */
- 0, /* EX_LOWW */
- 0, /* EX_HIGHW */
- LLDEF, /* EX_INREG */
- LLDEF, /* EX_REGVAR */
-};
-
-string salloc(),strcpy(),strcat();
-
-string mycat(s1,s2) string s1,s2; {
- register string s;
-
- s=salloc(strlen(s1)+strlen(s2));
- strcpy(s,s1);
- strcat(s,s2);
- return(s);
-}
-
-string mystrcpy(s) string s; {
- register string r;
-
- r=salloc(strlen(s));
- strcpy(r,s);
- return(r);
-}
-
-char digstr[21][15];
-
-string tostring(n) word n; {
- char buf[25];
-
- if (n>=-20 && n<=20 && (n&1)==0) {
- if (digstr[(n>>1)+10][0]==0)
- sprintf(digstr[(n>>1)+10],WRD_FMT,n);
- return(digstr[(n>>1)+10]);
- }
- sprintf(buf,WRD_FMT,n);
- return(mystrcpy(buf));
-}
-
-result_t undefres= {EV_UNDEF};
-
-result_t compute(node) node_p node; {
- result_t leaf1,leaf2,result;
- token_p tp;
- int desc;
- long mask,tmp;
- int i,tmpreg;
- glosym_p gp;
-
- desc=opdesc[node->ex_operator];
- if (desc&LLEAF) {
- leaf1 = compute(&enodes[node->ex_lnode]);
- if (desc&LDEF && leaf1.e_typ==EV_UNDEF)
- return(undefres);
- }
- if (desc&RLEAF) {
- leaf2 = compute(&enodes[node->ex_rnode]);
- if (desc&RDEF && leaf2.e_typ==EV_UNDEF)
- return(undefres);
- }
- result.e_typ=EV_INT;
- switch(node->ex_operator) {
- default: assert(FALSE);
- case EX_TOKFIELD:
- if (node->ex_lnode!=0)
- tp = &fakestack[stackheight-node->ex_lnode];
- else
- tp = curtoken;
- switch(result.e_typ = tokens[tp->t_token].t_type[node->ex_rnode-1]) {
- default:
- assert(FALSE);
- case EV_INT:
- result.e_v.e_con = tp->t_att[node->ex_rnode-1].aw;
- break;
- case EV_STR:
- result.e_v.e_str = tp->t_att[node->ex_rnode-1].as;
- break;
- case EV_REG:
- result.e_v.e_reg = tp->t_att[node->ex_rnode-1].ar;
- break;
- }
- return(result);
- case EX_ARG:
- return(dollar[node->ex_lnode-1]);
- case EX_CON:
- result.e_typ = EV_INT;
- result.e_v.e_con = ((long) node->ex_rnode << 16) | ((long)node->ex_lnode&0xffff);
- return(result);
- case EX_REG:
- result.e_typ = EV_REG;
- result.e_v.e_reg = node->ex_lnode;
- return(result);
- case EX_ALLREG:
- result.e_typ = EV_REG;
- result.e_v.e_reg = allreg[node->ex_lnode-1];
-#if MAXMEMBERS!=0
- if (node->ex_rnode!=0)
- result.e_v.e_reg = machregs[result.e_v.e_reg].
- r_members[node->ex_rnode-1];
-#endif
- return(result);
- case EX_SAMESIGN:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_typ = EV_INT;
- if (leaf1.e_v.e_con>=0)
- result.e_v.e_con= leaf2.e_v.e_con>=0;
- else
- result.e_v.e_con= leaf2.e_v.e_con<0;
- return(result);
- case EX_SFIT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- mask = 0xFFFFFFFFL;
- for (i=0;i<leaf2.e_v.e_con-1;i++)
- mask &= ~(1<<i);
- tmp = leaf1.e_v.e_con&mask;
- result.e_v.e_con = tmp==0||tmp==mask;
- return(result);
- case EX_UFIT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- mask = 0xFFFFFFFFL;
- for (i=0;i<leaf2.e_v.e_con;i++)
- mask &= ~(1<<i);
- result.e_v.e_con = (leaf1.e_v.e_con&mask)==0;
- return(result);
- case EX_ROM:
- assert(node->ex_rnode>=0 &&node->ex_rnode<MAXROM);
- leaf2=dollar[node->ex_lnode];
- if (leaf2.e_typ != EV_STR)
- return(undefres);
- gp = lookglo(leaf2.e_v.e_str);
- if (gp == (glosym_p) 0)
- return(undefres);
- if ((gp->gl_rom[MAXROM]&(1<<node->ex_rnode))==0)
- return(undefres);
- result.e_v.e_con = gp->gl_rom[node->ex_rnode];
- return(result);
- case EX_LOWW:
- result.e_v.e_con = saveemp[node->ex_lnode].em_u.em_loper&0xFFFF;
- return(result);
- case EX_HIGHW:
- result.e_v.e_con = saveemp[node->ex_lnode].em_u.em_loper>>16;
- return(result);
- case EX_NCPEQ:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con==leaf2.e_v.e_con;
- return(result);
- case EX_SCPEQ:
- assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
- result.e_v.e_con = !strcmp(leaf1.e_v.e_str,leaf2.e_v.e_str);
- return(result);
- case EX_RCPEQ:
- assert(leaf1.e_typ == EV_REG && leaf2.e_typ == EV_REG);
- result.e_v.e_con = leaf1.e_v.e_reg==leaf2.e_v.e_reg;
- return(result);
- case EX_NCPNE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con!=leaf2.e_v.e_con;
- return(result);
- case EX_SCPNE:
- assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
- result.e_v.e_con = strcmp(leaf1.e_v.e_str,leaf2.e_v.e_str);
- return(result);
- case EX_RCPNE:
- assert(leaf1.e_typ == EV_REG && leaf2.e_typ == EV_REG);
- result.e_v.e_con = leaf1.e_v.e_reg!=leaf2.e_v.e_reg;
- return(result);
- case EX_NCPGT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con>leaf2.e_v.e_con;
- return(result);
- case EX_NCPGE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con>=leaf2.e_v.e_con;
- return(result);
- case EX_NCPLT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con<leaf2.e_v.e_con;
- return(result);
- case EX_NCPLE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con<=leaf2.e_v.e_con;
- return(result);
- case EX_OR2:
- assert(leaf1.e_typ == EV_INT);
- if (leaf1.e_v.e_con==0)
- return(compute(&enodes[node->ex_rnode]));
- return(leaf1);
- case EX_AND2:
- assert(leaf1.e_typ == EV_INT);
- if (leaf1.e_v.e_con!=0)
- return(compute(&enodes[node->ex_rnode]));
- return(leaf1);
- case EX_PLUS:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con=leaf1.e_v.e_con+leaf2.e_v.e_con;
- return(result);
- case EX_CAT:
- assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
- result.e_typ = EV_STR;
- result.e_v.e_str = mycat(leaf1.e_v.e_str,leaf2.e_v.e_str);
- return(result);
- case EX_MINUS:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con - leaf2.e_v.e_con;
- return(result);
- case EX_TIMES:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con * leaf2.e_v.e_con;
- return(result);
- case EX_DIVIDE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con / leaf2.e_v.e_con;
- return(result);
- case EX_MOD:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con % leaf2.e_v.e_con;
- return(result);
- case EX_LSHIFT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con << leaf2.e_v.e_con;
- return(result);
- case EX_RSHIFT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con >> leaf2.e_v.e_con;
- return(result);
- case EX_NOT:
- assert(leaf1.e_typ == EV_INT);
- result.e_v.e_con = !leaf1.e_v.e_con;
- return(result);
- case EX_COMP:
- assert(leaf1.e_typ == EV_INT);
- result.e_v.e_con = ~leaf1.e_v.e_con;
- return(result);
- case EX_COST:
- if (node->ex_rnode==0)
- return(compute(&enodes[tokens[node->ex_lnode].t_cost.c_size]));
- else
- return(compute(&enodes[tokens[node->ex_lnode].t_cost.c_time]));
- case EX_STRING:
- result.e_typ = EV_STR;
- result.e_v.e_str = codestrings[node->ex_lnode];
- return(result);
- case EX_DEFINED:
- result.e_v.e_con=leaf1.e_typ!=EV_UNDEF;
- return(result);
- case EX_SUBREG:
- result.e_typ = EV_REG;
- tp= &fakestack[stackheight-node->ex_lnode];
- assert(tp->t_token == -1);
- tmpreg= tp->t_att[0].ar;
-#if MAXMEMBERS!=0
- if (node->ex_rnode)
- tmpreg=machregs[tmpreg].r_members[node->ex_rnode-1];
-#endif
- result.e_v.e_reg=tmpreg;
- return(result);
- case EX_TOSTRING:
- assert(leaf1.e_typ == EV_INT);
- result.e_typ = EV_STR;
- result.e_v.e_str = tostring(leaf1.e_v.e_con);
- return(result);
-#ifdef REGVARS
- case EX_INREG:
- assert(leaf1.e_typ == EV_INT);
- i = isregvar((long) leaf1.e_v.e_con);
- if (i<0)
- result.e_v.e_con = 0;
- else if (i==0)
- result.e_v.e_con = 1;
- else
- result.e_v.e_con = 2;
- return(result);
- case EX_REGVAR:
- assert(leaf1.e_typ == EV_INT);
- i = isregvar((long) leaf1.e_v.e_con);
- if (i<=0)
- return(undefres);
- result.e_typ = EV_REG;
- result.e_v.e_reg=i;
- return(result);
-#endif
- case EX_UMINUS:
- assert(leaf1.e_typ == EV_INT);
- result.e_v.e_con = -leaf1.e_v.e_con;
- return(result);
- }
-}
+++ /dev/null
-/* $Header$ */
-
-typedef struct {
- int t_token; /* kind of token, -1 for register */
- union {
- word aw; /* integer type */
- string as; /* string type */
- int ar; /* register type */
- } t_att[TOKENSIZE];
-} token_t,*token_p;
-
-struct reginfo {
- int r_repr; /* index in string table */
- int r_size; /* size in bytes */
-#if MAXMEMBERS!=0
- int r_members[MAXMEMBERS]; /* register contained within this reg */
- short r_clash[REGSETSIZE]; /* set of clashing registers */
-#endif
- int r_refcount; /* Times in use */
- token_t r_contents; /* Current contents */
- int r_tcount; /* Temporary count difference */
-};
-
-#if MAXMEMBERS!=0
-#define clash(a,b) ((machregs[a].r_clash[(b)>>4]&(1<<((b)&017)))!=0)
-#else
-#define clash(a,b) ((a)==(b))
-#endif
-
-typedef struct {
- int t_size; /* size in bytes */
- cost_t t_cost; /* cost in bytes and time */
- byte t_type[TOKENSIZE]; /* types of attributes, TT_??? */
- int t_format; /* index of formatstring */
-} tkdef_t,*tkdef_p;
-
-struct emline {
- int em_instr;
- int em_optyp;
- string em_soper;
- union {
- word em_ioper;
- long em_loper;
- } em_u;
-};
-
-#define OPNO 0
-#define OPINT 1
-#define OPSYMBOL 2
-
-typedef struct {
- int rl_n; /* number in list */
- int rl_list[NREGS];
-} rl_t,*rl_p;
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "equiv.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern string myalloc();
-
-int rar[MAXCREG];
-rl_p *lar;
-int maxindex;
-int regclass[NREGS];
-struct perm *perms;
-
-struct perm *
-tuples(regls,nregneeded) rl_p *regls; {
- int class=0;
- register i,j;
-
- /*
- * First compute equivalence classes of registers.
- */
-
- for (i=0;i<NREGS;i++) {
- regclass[i] = class++;
- if (getrefcount(i) == 0) {
- for (j=0;j<i;j++) {
- if (eqregclass(i,j) &&
- eqtoken(&machregs[i].r_contents,
- &machregs[j].r_contents)) {
- regclass[i] = regclass[j];
- break;
- }
- }
- }
- }
-
- /*
- * Now create tuples through a recursive function
- */
-
- maxindex = nregneeded;
- lar = regls;
- perms = 0;
- permute(0);
- return(perms);
-}
-
-permute(index) {
- register struct perm *pp;
- register rl_p rlp;
- register i,j;
-
- if (index == maxindex) {
- for (pp=perms; pp != 0; pp=pp->p_next) {
- for (i=0; i<maxindex; i++)
- if (regclass[rar[i]] != regclass[pp->p_rar[i]])
- goto diff;
- for (i=0; i<maxindex; i++)
- for (j=0; j<i; j++)
- if (clash(rar[i],rar[j]) !=
- clash(pp->p_rar[i],pp->p_rar[j]))
- goto diff;
- return;
- diff: ;
- }
- pp = (struct perm *) myalloc(sizeof ( *pp ));
- pp->p_next = perms;
- for (i=0; i<maxindex; i++)
- pp->p_rar[i] = rar[i];
- perms = pp;
- } else {
- rlp=lar[index];
- for (i=rlp->rl_n-1; i>=0; i--) {
- rar[index] = rlp->rl_list[i];
- permute(index+1);
- }
- }
-}
+++ /dev/null
-/* $Header$ */
-
-#define MAXCREG 4
-
-struct perm {
- struct perm *p_next;
- int p_rar[MAXCREG];
-};
+++ /dev/null
-/* $Header$ */
-
-extern int maxply; /* amount of lookahead allowed */
-extern int stackheight; /* # of tokens on fakestack */
-extern token_t fakestack[]; /* fakestack itself */
-extern int nallreg; /* number of allocated registers */
-extern int allreg[]; /* array of allocated registers */
-extern token_p curtoken; /* pointer to current token */
-extern result_t dollar[]; /* Values of $1,$2 etc.. */
-extern int nemlines; /* # of EM instructions in core */
-extern struct emline emlines[]; /* EM instructions itself */
-extern struct emline *emp; /* pointer to current instr */
-extern struct emline *saveemp; /* pointer to start of pattern */
-extern int tokpatlen; /* length of current stackpattern */
-extern rl_p curreglist; /* side effect of findcoerc() */
-#ifndef NDEBUG
-extern int Debug; /* on/off debug printout */
-#endif
-
-/*
- * Next descriptions are external declarations for tables created
- * by bootgram.
- * All definitions are to be found in tables.c (Not for humans)
- */
-
-extern byte coderules[]; /* pseudo code for cg itself */
-extern char stregclass[]; /* static register class */
-extern struct reginfo machregs[]; /* register info */
-extern tkdef_t tokens[]; /* token info */
-extern node_t enodes[]; /* expression nodes */
-extern string codestrings[]; /* table of strings */
-extern set_t machsets[]; /* token expression table */
-extern inst_t tokeninstances[]; /* token instance description table */
-extern move_t moves[]; /* move descriptors */
-extern byte pattern[]; /* EM patterns */
-extern int pathash[256]; /* Indices into previous */
-extern c1_t c1coercs[]; /* coercions type 1 */
-#ifdef MAXSPLIT
-extern c2_t c2coercs[]; /* coercions type 2 */
-#endif MAXSPLIT
-extern c3_t c3coercs[]; /* coercions type 3 */
-extern struct reginfo **reglist[]; /* lists of registers per property */
-
-#define eqregclass(r1,r2) (stregclass[r1]==stregclass[r2])
-
-#ifdef REGVARS
-extern int nregvar[]; /* # of register variables per type */
-extern int *rvnumbers[]; /* lists of numbers */
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid2[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "assert.h"
-#include <em_spec.h>
-#include <em_pseu.h>
-#include <em_flag.h>
-#include <em_ptyp.h>
-#include <em_mes.h>
-#include "mach.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#ifdef REGVARS
-#include "regvar.h"
-#include <em_reg.h>
-#endif
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/* segment types for switchseg() */
-#define SEGTXT 0
-#define SEGCON 1
-#define SEGROM 2
-#define SEGBSS 3
-
-long con();
-
-#define get8() getc(emfile)
-
-#define MAXSTR 256
-
-FILE *emfile;
-extern FILE *codefile;
-
-int nextispseu,savetab1;
-int opcode;
-int offtyp;
-long argval;
-int dlbval;
-char str[MAXSTR],argstr[32],labstr[32];
-int strsiz;
-int holno=0;
-int procno=0;
-int curseg= -1;
-int part_size=0;
-word part_word=0;
-int endofprog=0;
-#ifdef REGVARS
-int regallowed=0;
-#endif
-
-extern char em_flag[];
-extern short em_ptyp[];
-extern long atol();
-extern double atof();
-
-#define sp_cstx sp_cst2
-
-string tostring();
-string holstr();
-string strarg();
-string mystrcpy();
-long get32();
-
-in_init(filename) char *filename; {
-
- if ((emfile=freopen(filename,"r",stdin))==NULL)
- error("Can't open %s",filename);
- if (get16()!=sp_magic)
- error("Bad format %s",filename);
-}
-
-in_finish() {
-}
-
-fillemlines() {
- int t,i;
- register struct emline *lp;
-
- while ((emlines+nemlines)-emp<MAXEMLINES-5) {
- assert(nemlines<MAXEMLINES);
- if (nextispseu) {
- emlines[nemlines].em_instr=0;
- return;
- }
- lp = &emlines[nemlines++];
-
- switch(t=table1()) {
- default:
- error("unknown instruction byte");
- case sp_ilb1:
- case sp_ilb2:
- case sp_fpseu:
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- nextispseu=1; savetab1=t;
- nemlines--;
- lp->em_instr = 0;
- return;
- case EOF:
- nextispseu=1; savetab1=t;
- endofprog=1;
- nemlines--;
- lp->em_instr = 0;
- return;
- case sp_fmnem:
- lp->em_instr = opcode;
- break;
- }
- i=em_flag[lp->em_instr-sp_fmnem] & EM_PAR;
- if ( i == PAR_NO ) {
- lp->em_optyp = OPNO;
- lp->em_soper = 0;
- continue;
- }
- t= em_ptyp[i];
- t= getarg(t);
- switch(i) {
- case PAR_L:
- assert(t == sp_cstx);
- if (argval >= 0)
- argval += EM_BSIZE;
- lp->em_optyp = OPINT;
- lp->em_u.em_ioper = argval;
- lp->em_soper = tostring((word) argval);
- continue;
- case PAR_G:
- if (t != sp_cstx)
- break;
- lp->em_optyp = OPSYMBOL;
- lp->em_soper = holstr((word) argval);
- continue;
- case PAR_B:
- t = sp_ilb2;
- break;
- case PAR_D:
- assert(t == sp_cstx);
- lp->em_optyp = OPSYMBOL;
- lp->em_soper = strarg(t);
- lp->em_u.em_loper = argval;
- continue;
- }
- lp->em_soper = strarg(t);
- if (t==sp_cend)
- lp->em_optyp = OPNO;
- else if (t==sp_cstx) {
- lp->em_optyp = OPINT;
- lp->em_u.em_ioper = argval;
- } else
- lp->em_optyp = OPSYMBOL;
- }
-}
-
-dopseudo() {
- register b,t;
- register full n;
- register long save;
- word romcont[MAXROM+1];
- int nromwords;
- int rombit,rommask;
- unsigned dummy,stackupto();
-
- if (nextispseu==0 || nemlines>0)
- error("No table entry for %d",emlines[0].em_instr);
- nextispseu=0;
- switch(savetab1) {
- case sp_ilb1:
- case sp_ilb2:
- swtxt();
- dummy = stackupto(&fakestack[stackheight-1],maxply,TRUE);
- cleanregs();
- strarg(savetab1);
- newilb(argstr);
- return;
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- strarg(savetab1);
- savelab();
- return;
- case sp_fpseu:
- break;
- case EOF:
- swtxt();
- popstr(0);
- tstoutput();
- exit(0);
- default:
- error("Unknown opcode %d",savetab1);
- }
- switch (opcode) {
- case ps_hol:
- sprintf(labstr,hol_fmt,++holno);
- case ps_bss:
- getarg(cst_ptyp);
- n = (full) argval;
- t = getarg(val_ptyp);
- save = argval;
- getarg(cst_ptyp);
- b = (int) argval;
- argval = save;
- bss(n,t,b);
- break;
- case ps_con:
- switchseg(SEGCON);
- dumplab();
- con(getarg(val_ptyp));
- while ((t = getarg(any_ptyp)) != sp_cend)
- con(t);
- break;
- case ps_rom:
- switchseg(SEGROM);
- xdumplab();
- nromwords=0;
- rommask=0;
- rombit=1;
- t=getarg(val_ptyp);
- while (t!=sp_cend) {
- if (t==sp_cstx && nromwords<MAXROM) {
- romcont[nromwords] = (word) argval;
- rommask |= rombit;
- }
- nromwords++;
- rombit <<= 1;
- con(t);
- t=getarg(any_ptyp);
- }
- if (rommask != 0) {
- romcont[MAXROM]=rommask;
- enterglo(labstr,romcont);
- }
- labstr[0]=0;
- break;
- case ps_mes:
- getarg(ptyp(sp_cst2));
- if (argval == ms_emx) {
- getarg(ptyp(sp_cst2));
- if (argval != EM_WSIZE)
- fatal("bad word size");
- getarg(ptyp(sp_cst2));
- if (argval != EM_PSIZE)
- fatal("bad pointer size");
- if ( getarg(any_ptyp)!=sp_cend )
- fatal("too many parameters");
-#ifdef REGVARS
- } else if (argval == ms_gto) {
- getarg(ptyp(sp_cend));
- if (!regallowed)
- error("mes 3 not allowed here");
- fixregvars(TRUE);
- regallowed=0;
- } else if (argval == ms_reg) {
- long r_off;
- int r_size,r_type,r_score;
- struct regvar *linkreg();
-
- if (!regallowed)
- error("mes 3 not allowed here");
- if(getarg(ptyp(sp_cst2)|ptyp(sp_cend)) == sp_cend) {
- fixregvars(FALSE);
- regallowed=0;
- } else {
- r_off = argval;
-#ifdef EM_BSIZE
- if (r_off >= 0)
- r_off += EM_BSIZE;
-#endif
- getarg(ptyp(sp_cst2));
- r_size = argval;
- getarg(ptyp(sp_cst2));
- r_type = argval;
- if (r_type<reg_any || r_type>reg_float)
- fatal("Bad type in register message");
- if(getarg(ptyp(sp_cst2)|ptyp(sp_cend)) == sp_cend)
- r_score = 0;
- else {
- r_score = argval;
- if ( getarg(any_ptyp)!=sp_cend )
- fatal("too many parameters");
- }
- tryreg(linkreg(r_off,r_size,r_type,r_score),r_type);
- }
-#endif
- } else
- mes((word)argval);
- break;
- case ps_exa:
- strarg(getarg(sym_ptyp));
- ex_ap(argstr);
- break;
- case ps_ina:
- strarg(getarg(sym_ptyp));
- in_ap(argstr);
- break;
- case ps_exp:
- strarg(getarg(ptyp(sp_pnam)));
- ex_ap(argstr);
- break;
- case ps_inp:
- strarg(getarg(ptyp(sp_pnam)));
- in_ap(argstr);
- break;
- case ps_pro:
- switchseg(SEGTXT);
- procno++;
- strarg(getarg(ptyp(sp_pnam)));
- newilb(argstr);
- getarg(cst_ptyp);
- prolog((full)argval);
-#ifdef REGVARS
- regallowed++;
-#endif
- break;
- case ps_end:
- getarg(cst_ptyp | ptyp(sp_cend));
- cleanregs();
-#ifdef REGVARS
- unlinkregs();
-#endif
- tstoutput();
- break;
- default:
- error("No table entry for %d",savetab1);
- }
-}
-
-/* ----- input ----- */
-
-int getarg(typset) {
- register t,argtyp;
-
- argtyp = t = table2();
- if (t == EOF)
- fatal("unexpected EOF");
- t -= sp_fspec;
- t = 1 << t;
- if ((typset & t) == 0)
- error("bad argument type %d",argtyp);
- return(argtyp);
-}
-
-int table1() {
- register i;
-
- i = get8();
- if (i < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
- opcode = i;
- return(sp_fmnem);
- }
- if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {
- opcode = i;
- return(sp_fpseu);
- }
- if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {
- argval = i - sp_filb0;
- return(sp_ilb2);
- }
- return(table3(i));
-}
-
-int table2() {
- register i;
-
- i = get8();
- if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) {
- argval = i - sp_zcst0;
- return(sp_cstx);
- }
- return(table3(i));
-}
-
-int table3(i) {
- word consiz;
-
- switch(i) {
- case sp_ilb1:
- argval = get8();
- break;
- case sp_dlb1:
- dlbval = get8();
- break;
- case sp_dlb2:
- dlbval = get16();
- break;
- case sp_cst2:
- i = sp_cstx;
- case sp_ilb2:
- argval = get16();
- break;
- case sp_cst4:
- i = sp_cstx;
- argval = get32();
- break;
- case sp_dnam:
- case sp_pnam:
- case sp_scon:
- getstring();
- break;
- case sp_doff:
- offtyp = getarg(sym_ptyp);
- getarg(cst_ptyp);
- break;
- case sp_icon:
- case sp_ucon:
- case sp_fcon:
- getarg(cst_ptyp);
- consiz = (word) argval;
- getstring();
- argval = consiz;
- break;
- }
- return(i);
-}
-
-int get16() {
- register int l_byte, h_byte;
-
- l_byte = get8();
- h_byte = get8();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-long get32() {
- register long l;
- register int h_byte;
-
- l = get8();
- l |= ((unsigned) get8())*256 ;
- l |= get8()*256L*256L ;
- h_byte = get8() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-
-getstring() {
- register char *p;
- register n;
-
- getarg(cst_ptyp);
- if (argval < 0 || argval > MAXSTR-1)
- fatal("string/identifier too long");
- strsiz = n = (int) argval;
- p = str;
- while (--n >= 0)
- *p++ = get8();
- *p++ = '\0';
-}
-
-char *strarg(t) {
- register char *p;
-
- switch (t) {
- case sp_ilb1:
- case sp_ilb2:
- sprintf(argstr,ilb_fmt,procno,(int)argval);
- break;
- case sp_dlb1:
- case sp_dlb2:
- sprintf(argstr,dlb_fmt,dlbval);
- break;
- case sp_cstx:
- sprintf(argstr,cst_fmt,(full)argval);
- break;
- case sp_dnam:
- case sp_pnam:
- p = argstr;
- if (strsiz < 8 || str[0] == id_first)
- *p++ = id_first;
- sprintf(p,"%.*s",strsiz,str);
- break;
- case sp_doff:
- strarg(offtyp);
- for (p = argstr; *p; p++)
- ;
- if (argval >= 0)
- *p++ = '+';
- sprintf(p,off_fmt,(full)argval);
- break;
- case sp_cend:
- return("");
- }
- return(mystrcpy(argstr));
-}
-
-bss(n,t,b) full n; {
- register long s;
-
- if (n % EM_WSIZE)
- fatal("bad BSS size");
- if (b==0
-#ifdef BSS_INIT
- || (t==sp_cstx && argval==BSS_INIT)
-#endif BSS_INIT
- ) {
- switchseg(SEGBSS);
- newlbss(labstr,n);
- labstr[0]=0;
- return;
- }
- switchseg(SEGCON);
- dumplab();
- while (n > 0)
- n -= (s = con(t));
- if (s % EM_WSIZE)
- fatal("bad BSS initializer");
-}
-
-long con(t) {
- register i;
-
- strarg(t);
- switch (t) {
- case sp_ilb1:
- case sp_ilb2:
- case sp_pnam:
- part_flush();
- con_ilb(argstr);
- return((long)EM_PSIZE);
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- case sp_doff:
- part_flush();
- con_dlb(argstr);
- return((long)EM_PSIZE);
- case sp_cstx:
- con_part(EM_WSIZE,(word)argval);
- return((long)EM_WSIZE);
- case sp_scon:
- for (i = 0; i < strsiz; i++)
- con_part(1,(word) str[i]);
- return((long)strsiz);
- case sp_icon:
- case sp_ucon:
- if (argval > EM_WSIZE) {
- part_flush();
- con_mult((word)argval);
- } else {
- con_part((int)argval,(word)atol(str));
- }
- return(argval);
- case sp_fcon:
- part_flush();
- con_float();
- return(argval);
- }
- assert(FALSE);
- /* NOTREACHED */
-}
-
-extern char *segname[];
-
-swtxt() {
- switchseg(SEGTXT);
-}
-
-switchseg(s) {
-
- if (s == curseg)
- return;
- part_flush();
- if ((curseg = s) >= 0)
- fprintf(codefile,"%s\n",segname[s]);
-}
-
-savelab() {
- register char *p,*q;
-
- part_flush();
- if (labstr[0]) {
- dlbdlb(argstr,labstr);
- return;
- }
- p = argstr;
- q = labstr;
- while (*q++ = *p++)
- ;
-}
-
-dumplab() {
-
- if (labstr[0] == 0)
- return;
- assert(part_size == 0);
- newdlb(labstr);
- labstr[0] = 0;
-}
-
-xdumplab() {
-
- if (labstr[0] == 0)
- return;
- assert(part_size == 0);
- newdlb(labstr);
-}
-
-part_flush() {
-
- /*
- * Each new data fragment and each data label starts at
- * a new target machine word
- */
- if (part_size == 0)
- return;
- con_cst(part_word);
- part_size = 0;
- part_word = 0;
-}
-
-string holstr(n) word n; {
-
- sprintf(str,hol_off,n,holno);
- return(mystrcpy(str));
-}
-
-
-/* ----- machine dependent routines ----- */
-
-#include "mach.c"
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include <stdio.h>
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-FILE *codefile;
-
-out_init(filename) char *filename; {
-
-#ifndef NDEBUG
- static char stderrbuff[512];
-
- if (Debug) {
- codefile = stderr;
- if (!isatty(2))
- setbuf(stderr,stderrbuff);
- } else {
-#endif
- if (filename == (char *) 0)
- codefile = stdout;
- else
- if ((codefile=freopen(filename,"w",stdout))==NULL)
- error("Can't create %s",filename);
-#ifndef NDEBUG
- }
-#endif
-}
-
-out_finish() {
-
-#ifndef NDEBUG
- if (Debug)
- fflush(stderr);
- else
-#endif
- fclose(codefile);
-}
-
-tstoutput() {
-
- if (ferror(codefile))
- error("Write error on output");
-}
-
-gencode(code) register char *code; {
- register c;
- int tokno,fldno,insno,regno,subno;
- register token_p tp;
-
- swtxt();
- while ((c= *code++)!=0) switch(c) {
- default:
- fputc(c,codefile);
- break;
- case PR_TOK:
- tokno = *code++;
- tp = &fakestack[stackheight-tokno];
- if (tp->t_token==-1)
- fprintf(codefile,"%s",codestrings[machregs[tp->t_att[0].ar].r_repr]);
- else
- prtoken(tp);
- break;
- case PR_TOKFLD:
- tokno = *code++;
- fldno = *code++;
- tp = &fakestack[stackheight-tokno];
- assert(tp->t_token != -1);
- switch(tokens[tp->t_token].t_type[fldno-1]) {
- default:
- assert(FALSE);
- case EV_INT:
- fprintf(codefile,WRD_FMT,tp->t_att[fldno-1].aw);
- break;
- case EV_STR:
- fprintf(codefile,"%s",tp->t_att[fldno-1].as);
- break;
- case EV_REG:
- assert(tp->t_att[fldno-1].ar>0 && tp->t_att[fldno-1].ar<NREGS);
- fprintf(codefile,"%s",codestrings[machregs[tp->t_att[fldno-1].ar].r_repr]);
- break;
- }
- break;
- case PR_EMINT:
- insno = *code++;
- fprintf(codefile,WRD_FMT,dollar[insno-1].e_v.e_con);
- break;
- case PR_EMSTR:
- insno = *code++;
- fprintf(codefile,"%s",dollar[insno-1].e_v.e_str);
- break;
- case PR_ALLREG:
- regno = *code++;
- subno = (*code++)&0377;
- assert(regno>=1 && regno<=nallreg);
- regno = allreg[regno-1];
-#if MAXMEMBERS!=0
- if (subno!=255) {
- assert(subno>=1 && subno<=MAXMEMBERS);
- regno = machregs[regno].r_members[subno-1];
- assert(regno!=0);
- }
-#endif
- fprintf(codefile,"%s",codestrings[machregs[regno].r_repr]);
- break;
-#if MAXMEMBERS!=0
- case PR_SUBREG:
- tokno = *code++;
- subno = *code++;
- tp = &fakestack[stackheight-tokno];
- assert(tp->t_token == -1);
- fprintf(codefile,"%s",codestrings[machregs[machregs[tp->t_att[0].ar].r_members[subno-1]].r_repr]);
- break;
-#endif
- }
-}
-
-genexpr(nodeno) {
- result_t result;
-
- result= compute(&enodes[nodeno]);
- switch(result.e_typ) {
- default: assert(FALSE);
- case EV_INT:
- fprintf(codefile,WRD_FMT,result.e_v.e_con);
- break;
- case EV_REG:
- fprintf(codefile,"%s", codestrings[machregs[result.e_v.e_reg].r_repr]);
- break;
- case EV_STR:
- fprintf(codefile,"%s",result.e_v.e_str);
- break;
- }
-}
-
-gennl() {
- fputc('\n',codefile);
-}
-
-prtoken(tp) token_p tp; {
- register c;
- register char *code;
- register tkdef_p tdp;
-
- tdp = &tokens[tp->t_token];
- assert(tdp->t_format != -1);
- code = codestrings[tdp->t_format];
- while ((c = *code++) != 0) {
- if (c>=' ' && c<='~')
- fputc(c,codefile);
- else {
- assert(c>0 && c<=TOKENSIZE);
- switch(tdp->t_type[c-1]) {
- default:
- assert(FALSE);
- case EV_INT:
- fprintf(codefile,WRD_FMT,tp->t_att[c-1].aw);
- break;
- case EV_STR:
- fprintf(codefile,"%s",tp->t_att[c-1].as);
- break;
- case EV_REG:
- fprintf(codefile,"%s",codestrings[machregs[tp->t_att[c-1].ar].r_repr]);
- break;
- }
- }
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include "glosym.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern string myalloc();
-
-glosym_p glolist= (glosym_p) 0;
-
-enterglo(name,romp) string name; word *romp; {
- register glosym_p gp;
- register i;
-
- gp = (glosym_p) myalloc(sizeof *gp);
- gp->gl_next = glolist;
- gp->gl_name = (string) myalloc(strlen(name)+1);
- strcpy(gp->gl_name,name);
- for (i=0;i<=MAXROM;i++)
- gp->gl_rom[i] = romp[i];
- glolist = gp;
-}
-
-glosym_p lookglo(name) string name; {
- register glosym_p gp;
-
- for (gp=glolist;gp != (glosym_p) 0; gp=gp->gl_next)
- if (strcmp(gp->gl_name,name)==0)
- return(gp);
- return((glosym_p) 0);
-}
+++ /dev/null
-/* $Header$ */
-
-typedef struct glosym {
- struct glosym *gl_next;
- string gl_name;
- word gl_rom[MAXROM+1];
-} glosym_t,*glosym_p;
-
-glosym_p lookglo();
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-char *progname;
-extern char startupcode[];
-int maxply=1;
-#ifndef NDEBUG
-int Debug=0;
-#endif
-
-extern int endofprog;
-
-main(argc,argv) char **argv; {
- register unsigned n;
- extern unsigned cc1,cc2,cc3,cc4;
- unsigned ggd();
-
- progname = argv[0];
- while (--argc && **++argv == '-') {
- switch(argv[0][1]) {
-#ifndef NDEBUG
- case 'd':
- Debug=1; break;
-#endif
- case 'p':
- maxply = atoi(argv[0]+2);
- break;
- case 'w': /* weight percentage for size */
- n=atoi(argv[0]+2);
- cc1 *= n;
- cc2 *= 50;
- cc3 *= (100-n);
- cc4 *= 50;
- n=ggd(cc1,cc2);
- cc1 /= n;
- cc2 /= n;
- n=ggd(cc3,cc4);
- cc3 /= n;
- cc4 /= n;
- break;
- default:
- error("Unknown flag %c",argv[0][1]);
- }
- }
- if (argc < 1 || argc > 2)
- error("Usage: %s EMfile [ asfile ]",progname);
- in_init(argv[0]);
- out_init(argv[1]);
- codegen(startupcode,maxply,TRUE,MAXINT,0);
- in_finish();
- if (!endofprog)
- error("Bombed out of codegen");
- out_finish();
-}
-
-unsigned ggd(a,b) register unsigned a,b; {
- register unsigned c;
-
- do {
- c = a%b; a=b; b=c;
- } while (c!=0);
- return(a);
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-unsigned costcalc();
-
-move(tp1,tp2,ply,toplevel,maxcost) token_p tp1,tp2; unsigned maxcost; {
- register move_p mp;
- register unsigned t;
- register struct reginfo *rp;
- tkdef_p tdp;
- int i;
- unsigned codegen();
-
- if (eqtoken(tp1,tp2))
- return(0);
- if (tp2->t_token == -1) {
- if (tp1->t_token == -1) {
- if (eqtoken(&machregs[tp1->t_att[0].ar].r_contents,
- &machregs[tp2->t_att[0].ar].r_contents) &&
- machregs[tp1->t_att[0].ar].r_contents.t_token!=0)
- return(0);
- if (tp1->t_att[0].ar!=1) { /* COCO reg; tmp kludge */
- erasereg(tp2->t_att[0].ar);
- machregs[tp2->t_att[0].ar].r_contents =
- machregs[tp1->t_att[0].ar].r_contents ;
- } else
- machregs[tp1->t_att[0].ar].r_contents =
- machregs[tp2->t_att[0].ar].r_contents ;
- } else {
- if (eqtoken(&machregs[tp2->t_att[0].ar].r_contents,tp1))
- return(0);
- machregs[tp2->t_att[0].ar].r_contents = *tp1;
- }
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- if (rp->r_contents.t_token == 0)
- continue;
- assert(rp->r_contents.t_token > 0);
- tdp = &tokens[rp->r_contents.t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_REG &&
- clash(rp->r_contents.t_att[i].ar,tp2->t_att[0].ar)) {
- erasereg(rp-machregs);
- break;
- }
- }
- } else if (tp1->t_token == -1) {
- if (eqtoken(tp2,&machregs[tp1->t_att[0].ar].r_contents))
- return(0);
- machregs[tp1->t_att[0].ar].r_contents = *tp2;
- }
- /*
- * If we arrive here the move must really be executed
- */
- for (mp=moves;mp<moves+NMOVES;mp++) {
- if (!match(tp1,&machsets[mp->m_set1],mp->m_expr1))
- continue;
- if (match(tp2,&machsets[mp->m_set2],mp->m_expr2))
- break;
- /*
- * Correct move rule is found
- */
- }
- assert(mp<moves+NMOVES);
- /*
- * To get correct interpretation of things like %[1]
- * in move code we stack tp2 and tp1. This little trick
- * saves a lot of testing in other places.
- */
-
- if (mp->m_cindex!=0) {
- fakestack[stackheight] = *tp2;
- fakestack[stackheight+1] = *tp1;
- stackheight += 2;
- t = codegen(&coderules[mp->m_cindex],ply,toplevel,maxcost,0);
- if (t <= maxcost)
- t += costcalc(mp->m_cost);
- stackheight -= 2;
- } else {
- t = 0;
- }
- return(t);
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <em_spec.h>
-#include <em_flag.h>
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#ifndef NDEBUG
-#include <stdio.h>
-extern char em_mnem[][4];
-#endif
-
-byte *trypat(bp,len) register byte *bp; {
- register patlen,i;
- result_t result;
-
- getint(patlen,bp);
- if (len == 3) {
- if (patlen < 3)
- return(0);
- } else {
- if (patlen != len)
- return(0);
- }
- for(i=0;i<patlen;i++)
- if (emp[i].em_instr != (*bp++&BMASK))
- return(0);
- for (i=0;i<patlen;i++)
- if (emp[i].em_optyp==OPNO)
- dollar[i].e_typ=EV_UNDEF;
- else if ((dollar[i].e_typ=argtyp(emp[i].em_instr))==EV_INT)
- dollar[i].e_v.e_con=emp[i].em_u.em_ioper;
- else
- dollar[i].e_v.e_str=emp[i].em_soper;
- getint(i,bp);
- if (i!=0) {
- result = compute(&enodes[i]);
- if (result.e_typ != EV_INT || result.e_v.e_con == 0)
- return(0);
- }
-#ifndef NDEBUG
- if (Debug) {
- fprintf(stderr,"Matched:");
- for (i=0;i<patlen;i++)
- fprintf(stderr," %3.3s",em_mnem[emp[i].em_instr-sp_fmnem]);
- fprintf(stderr,"\n");
- }
-#endif
- saveemp = emp;
- emp += patlen;
- return(bp);
-}
-
-extern char em_flag[];
-
-argtyp(mn) {
-
- switch(em_flag[mn-sp_fmnem]&EM_PAR) {
- case PAR_W:
- case PAR_S:
- case PAR_Z:
- case PAR_O:
- case PAR_N:
- case PAR_L:
- case PAR_F:
- case PAR_R:
- case PAR_C:
- return(EV_INT);
- default:
- return(EV_STR);
- }
-}
-
-byte *nextem(toplevel) {
- register i;
- short hash[3];
- register byte *bp;
- byte *cp;
- int index;
- register struct emline *ep;
-
- if (toplevel) {
- if (nemlines && emp>emlines) {
- nemlines -= emp-emlines;
- for (i=0,ep=emlines;i<nemlines;i++)
- *ep++ = *emp++;
- emp=emlines;
- }
- fillemlines();
- }
- hash[0] = emp[0].em_instr;
- hash[1] = (hash[0]<<4) ^ emp[1].em_instr;
- hash[2] = (hash[1]<<4) ^ emp[2].em_instr;
- for (i=2;i>=0;i--) {
- index = pathash[hash[i]&BMASK];
- while (index != 0) {
- bp = &pattern[index];
- if ( bp[PO_HASH] == (hash[i]>>8))
- if ((cp=trypat(&bp[PO_MATCH],i+1)) != 0)
- return(cp);
- index = (bp[PO_NEXT]&BMASK) | (bp[PO_NEXT+1]<<8);
- }
- }
- return(0);
-}
+++ /dev/null
-/* $Header$ */
-
-#define BMASK 0377
-#define BSHIFT 8
-
-#define TRUE 1
-#define FALSE 0
-
-#define MAXINT 32767
-#define INFINITY (MAXINT+100)
-
-#define MAXROM 3
-
-/*
- * Tunable constants
- */
-
-#define MAXEMLINES 20
-#define MAXFSTACK 20
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-chrefcount(regno,amount,tflag) {
- register struct reginfo *rp;
- register i;
-
- rp= &machregs[regno];
-#if MAXMEMBERS!=0
- if (rp->r_members[0]==0) {
-#endif
- rp->r_refcount += amount;
- if (tflag)
- rp->r_tcount += amount;
- assert(rp->r_refcount >= 0);
-#if MAXMEMBERS!=0
- } else
- for (i=0;i<MAXMEMBERS;i++)
- if (rp->r_members[i]!=0)
- chrefcount(rp->r_members[i],amount,tflag);
-#endif
-}
-
-getrefcount(regno) {
- register struct reginfo *rp;
- register i,maxcount;
-
- rp= &machregs[regno];
-#if MAXMEMBERS!=0
- if (rp->r_members[0]==0)
-#endif
- return(rp->r_refcount);
-#if MAXMEMBERS!=0
- else {
- maxcount=0;
- for (i=0;i<MAXMEMBERS;i++)
- if (rp->r_members[i]!=0)
- maxcount=max(maxcount,getrefcount(rp->r_members[i]));
- return(maxcount);
- }
-#endif
-}
-
-erasereg(regno) {
- register struct reginfo *rp;
-
-#if MAXMEMBERS==0
- awayreg(regno);
-#else
- for (rp=machregs;rp<machregs+NREGS;rp++)
- if (rp->r_clash[regno>>4]&(1<<(regno&017)))
- awayreg(rp-machregs);
-#endif
-}
-
-awayreg(regno) {
- register struct reginfo *rp;
- register tkdef_p tdp;
- register i;
-
- rp = &machregs[regno];
- rp->r_contents.t_token = 0;
- for (i=0;i<TOKENSIZE;i++)
- rp->r_contents.t_att[i].aw = 0;
-
- /* Now erase recursively all registers containing
- * something using this one
- */
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- if (rp->r_contents.t_token == -1) {
- if (rp->r_contents.t_att[0].ar == regno)
- erasereg(rp-machregs);
- } else {
- tdp= & tokens[rp->r_contents.t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_REG &&
- rp->r_contents.t_att[i].ar == regno) {
- erasereg(rp-machregs);
- break;
- }
- }
- }
-}
-
-cleanregs() {
- register struct reginfo *rp;
- register i;
-
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- rp->r_contents.t_token = 0;
- for (i=0;i<TOKENSIZE;i++)
- rp->r_contents.t_att[i].aw = 0;
- }
-}
-
-#ifndef NDEBUG
-inctcount(regno) {
- register struct reginfo *rp;
- register i;
-
- rp = &machregs[regno];
-#if MAXMEMBERS!=0
- if (rp->r_members[0] == 0) {
-#endif
- rp->r_tcount++;
-#if MAXMEMBERS!=0
- } else {
- for (i=0;i<MAXMEMBERS;i++)
- if (rp->r_members[i] != 0)
- inctcount(rp->r_members[i]);
- }
-#endif
-}
-
-chkregs() {
- register struct reginfo *rp;
- register token_p tp;
- register tkdef_p tdp;
- int i;
-
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- assert(rp->r_tcount==0);
- }
- for (tp=fakestack;tp<fakestack+stackheight;tp++) {
- if (tp->t_token == -1)
- inctcount(tp->t_att[0].ar);
- else {
- tdp = &tokens[tp->t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG)
- inctcount(tp->t_att[i].ar);
- }
- }
-#ifdef REGVARS
-#include <em_reg.h>
- for(i=reg_any;i<=reg_float;i++) {
- int j;
- for(j=0;j<nregvar[i];j++)
- inctcount(rvnumbers[i][j]);
- }
-#endif REGVARS
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- assert(rp->r_refcount==rp->r_tcount);
- rp->r_tcount=0;
- }
-}
-#endif
+++ /dev/null
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-
-#ifdef REGVARS
-
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "regvar.h"
-#include <em_reg.h>
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-struct regvar *rvlist;
-
-struct regvar *
-linkreg(of,sz,tp,sc) long of; {
- struct regvar *rvlp;
-
- rvlp= (struct regvar *) myalloc(sizeof *rvlp);
- rvlp->rv_next = rvlist;
- rvlist=rvlp;
- rvlp->rv_off = of;
- rvlp->rv_size = sz;
- rvlp->rv_type = tp;
- rvlp->rv_score = sc;
- rvlp->rv_reg = 0; /* no register assigned yet */
- return(rvlp);
-}
-
-tryreg(rvlp,typ) struct regvar *rvlp; {
- int score;
- register i;
- struct regassigned *ra;
- struct regvar *save;
-
- if (typ != reg_any && nregvar[typ]!=0) {
- if (machregs[rvnumbers[typ][0]].r_size!=rvlp->rv_size)
- score = -1;
- else
- score = regscore(rvlp->rv_off,
- rvlp->rv_size,
- rvlp->rv_type,
- rvlp->rv_score,
- typ); /* machine dependent */
- ra = regassigned[typ];
- if (score>ra[nregvar[typ]-1].ra_score) {
- save = ra[nregvar[typ]-1].ra_rv;
- for (i=nregvar[typ]-1;i>0 && ra[i-1].ra_score<score;i--)
- ra[i] = ra[i-1];
- ra[i].ra_rv = rvlp;
- ra[i].ra_score = score;
- if((rvlp=save)==0)
- return;
- }
- }
- if (nregvar[reg_any]==0)
- return;
- if (machregs[rvnumbers[reg_any][0]].r_size!=rvlp->rv_size)
- score = -1;
- else
- score = regscore(rvlp->rv_off,
- rvlp->rv_size,
- rvlp->rv_type,
- rvlp->rv_score,
- reg_any); /* machine dependent */
- ra = regassigned[reg_any];
- if (score>ra[nregvar[reg_any]-1].ra_score) {
- for (i=nregvar[reg_any]-1;i>0 && ra[i-1].ra_score<score;i--)
- ra[i] = ra[i-1];
- ra[i].ra_rv = rvlp;
- ra[i].ra_score = score;
- }
-}
-
-fixregvars(saveall) {
- register struct regvar *rv;
- register rvtyp,i;
-
- swtxt();
- i_regsave(); /* machine dependent initialization */
- for (rvtyp=reg_any;rvtyp<=reg_float;rvtyp++) {
- for(i=0;i<nregvar[rvtyp];i++)
- if (saveall) {
- struct reginfo *rp;
- rp= &machregs[rvnumbers[rvtyp][i]];
- regsave(codestrings[rp->r_repr],-EM_WSIZE,rp->r_size);
- } else if(regassigned[rvtyp][i].ra_score>0) {
- rv=regassigned[rvtyp][i].ra_rv;
- rv->rv_reg=rvnumbers[rvtyp][i];
- regsave(codestrings[machregs[rv->rv_reg].r_repr],
- rv->rv_off,rv->rv_size);
- }
- }
- f_regsave();
-#ifndef EM_BSIZE
- for(rv=rvlist;rv!=0;rv=rv->rv_next)
- if (rv->rv_off >= 0) rv->rv_off += EM_BSIZE;
-#endif
-}
-
-isregvar(off) long off; {
- register struct regvar *rvlp;
-
- for(rvlp=rvlist;rvlp!=0;rvlp=rvlp->rv_next)
- if(rvlp->rv_off == off)
- return(rvlp->rv_reg);
- return(-1);
-}
-
-unlinkregs() {
- register struct regvar *rvlp,*t;
- register struct regassigned *ra;
- int rvtyp,i;
-
- for(rvlp=rvlist;rvlp!=0;rvlp=t) {
- t=rvlp->rv_next;
- myfree(rvlp);
- }
- rvlist=0;
- for (rvtyp=reg_any;rvtyp<=reg_float;rvtyp++) {
- for(i=0;i<nregvar[rvtyp];i++) {
- ra= ®assigned[rvtyp][i];
- ra->ra_rv = 0;
- ra->ra_score = 0;
- }
- }
-}
-
-#endif REGVARS
-
-/* nothing after this */
+++ /dev/null
-/* $Header$ */
-
-struct regvar {
- struct regvar *rv_next;
- long rv_off;
- int rv_size;
- int rv_type;
- int rv_score;
- int rv_reg;
-};
-
-struct regassigned {
- struct regvar *ra_rv;
- int ra_score;
-};
-
-extern struct regvar *rvlist;
-extern int nregvar[];
-extern struct regassigned *regassigned[];
+++ /dev/null
-/* $Header$ */
-
-struct result {
- int e_typ; /* EV_INT,EV_REG,EV_STR */
- union {
- word e_con;
- int e_reg;
- string e_str;
- } e_v; /* value */
-};
-
-#define EV_UNDEF 0
-#define EV_INT 1
-#define EV_REG 2
-#define EV_STR 3
-
-typedef struct result result_t;
-
-extern result_t compute();
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/*
- * Package for string allocation and garbage collection.
- * Call salloc(size) to get room for string.
- * Every now and then call garbage_collect() from toplevel.
- */
-
-#define MAXSTAB 500
-#define THRESHOLD 200
-
-char *stab[MAXSTAB];
-int nstab=0;
-string malloc();
-
-string myalloc(size) {
- register string p;
-
- p = (string) malloc(size);
- if (p==0)
- fatal("Out of memory");
- return(p);
-}
-
-myfree(p) string p; {
-
- free(p);
-}
-
-popstr(nnstab) {
- register i;
-
- for (i=nnstab;i<nstab;i++)
- myfree(stab[i]);
- nstab = nnstab;
-}
-
-char *salloc(size) {
- register char *p;
-
- if (nstab==MAXSTAB)
- fatal("String table overflow");
- p = myalloc(size+1); /* extra room for terminating zero */
- stab[nstab++] = p;
- return(p);
-}
-
-compar(p1,p2) char **p1,**p2; {
-
- assert(*p1 != *p2);
- if (*p1 < *p2)
- return(-1);
- return(1);
-}
-
-garbage_collect() {
- register i;
- struct emline *emlp;
- token_p tp;
- tkdef_p tdp;
- struct reginfo *rp;
- register char **fillp,**scanp;
- char used[MAXSTAB]; /* could be bitarray */
-
- if (nstab<THRESHOLD)
- return;
- qsort(stab,nstab,sizeof (char *),compar);
- for (i=0;i<nstab;i++)
- used[i]= FALSE;
- for(emlp=emlines;emlp<emlines+nemlines;emlp++)
- chkstr(emlp->em_soper,used);
- for (tp= fakestack;tp<&fakestack[stackheight];tp++) {
- if (tp->t_token== -1)
- continue;
- tdp = &tokens[tp->t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_STR)
- chkstr(tp->t_att[i].as,used);
- }
- for (rp= machregs; rp<machregs+NREGS; rp++) {
- tp = &rp->r_contents;
- assert(tp->t_token != -1);
- tdp= &tokens[tp->t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_STR)
- chkstr(tp->t_att[i].as,used);
- }
- for (i=0;i<nstab;i++)
- if (!used[i]) {
- myfree(stab[i]);
- stab[i]=0;
- }
- fillp=stab;
- for (scanp=stab;scanp<stab+nstab;scanp++)
- if (*scanp != 0)
- *fillp++ = *scanp;
- nstab = fillp-stab;
-}
-
-chkstr(str,used) string str; char used[]; {
- register low,middle,high;
-
- low=0; high=nstab-1;
- while (high>low) {
- middle= (low+high)>>1;
- if (str==stab[middle]) {
- used[middle]=1;
- return;
- }
- if (str<stab[middle])
- high = middle-1;
- else
- low = middle+1;
- }
- if (low==high) {
- if (str==stab[low]) {
- used[low]=1;
- }
- return;
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "state.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern int nstab; /* salloc.c */
-
-#ifndef STONSTACK
-extern string myalloc();
-
-state_p stlist=0;
-#endif
-
-#ifdef STONSTACK
-savestatus(sp) register state_p sp; {
-#else
-state_p savestatus() {
- register state_p sp;
-
- if ((sp=stlist)==0)
- sp = (state_p) myalloc( sizeof( *sp ) );
- else
- stlist=sp->st_next;
-#endif
- sp->st_sh = stackheight;
- bmove((short *)fakestack,(short *)sp->st_fs,stackheight*sizeof(token_t));
- sp->st_na = nallreg;
- bmove((short *)allreg,(short *)sp->st_ar,nallreg*sizeof(int));
- sp->st_ct = curtoken;
- bmove((short *)dollar,(short *)sp->st_do,LONGESTPATTERN*sizeof(result_t));
- bmove((short *)machregs,(short *)sp->st_mr,NREGS*sizeof(struct reginfo));
- sp->st_ne = nemlines;
- bmove((short *)emlines,(short *)sp->st_el,nemlines*sizeof(struct emline));
- sp->st_em = emp;
- sp->st_se = saveemp;
- sp->st_tl = tokpatlen;
- sp->st_ns = nstab;
-#ifndef STONSTACK
- return(sp);
-#endif
-}
-
-restorestatus(sp) register state_p sp; {
-
- stackheight = sp->st_sh;
- bmove((short *)sp->st_fs,(short *)fakestack,stackheight*sizeof(token_t));
- nallreg = sp->st_na;
- bmove((short *)sp->st_ar,(short *)allreg,nallreg*sizeof(int));
- curtoken = sp->st_ct;
- bmove((short *)sp->st_do,(short *)dollar,LONGESTPATTERN*sizeof(result_t));
- bmove((short *)sp->st_mr,(short *)machregs,NREGS*sizeof(struct reginfo));
- nemlines = sp->st_ne;
- bmove((short *)sp->st_el,(short *)emlines,nemlines*sizeof(struct emline));
- emp = sp->st_em;
- saveemp = sp->st_se;
- tokpatlen = sp->st_tl;
- popstr(sp->st_ns);
-}
-
-#ifndef STONSTACK
-freestatus(sp) state_p sp; {
-
- sp->st_next = stlist;
- stlist = sp;
-}
-#endif
-
-bmove(from,to,nbytes) register short *from,*to; register nbytes; {
-
- if (nbytes<=0)
- return;
- assert(sizeof(short)==2 && (nbytes&1)==0);
- nbytes>>=1;
- do
- *to++ = *from++;
- while (--nbytes);
-}
+++ /dev/null
-/* $Header$ */
-
-#define STONSTACK /* if defined state is saved in stackframe */
-
-typedef struct state {
- struct state *st_next; /* for linked list */
- int st_sh; /* stackheight */
- token_t st_fs[MAXFSTACK]; /* fakestack */
- int st_na; /* nallreg */
- int st_ar[MAXALLREG]; /* allreg[] */
- token_p st_ct; /* curtoken */
- result_t st_do[LONGESTPATTERN]; /* dollar[] */
- struct reginfo st_mr[NREGS]; /* machregs[] */
- int st_ne; /* nemlines */
- struct emline st_el[MAXEMLINES]; /* emlines[] */
- struct emline *st_em; /* emp */
- struct emline *st_se; /* saveemp */
- int st_tl; /* tokpatlen */
- int st_ns; /* nstab */
-} state_t,*state_p;
-
-#ifndef STONSTACK
-state_p savestatus();
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include <stdio.h>
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-string myalloc();
-unsigned codegen();
-
-match(tp,tep,optexp) register token_p tp; register set_p tep; {
- register bitno;
- token_p ct;
- result_t result;
-
- if (tp->t_token == -1) { /* register frame */
- bitno = tp->t_att[0].ar+1;
- if (tep->set_val[bitno>>4]&(1<<(bitno&017)))
- if (tep->set_val[0]&1 || getrefcount(tp->t_att[0].ar)<=1)
- goto oklabel;
- return(0);
- } else { /* token frame */
- bitno = tp->t_token+NREGS+1;
- if ((tep->set_val[bitno>>4]&(1<<(bitno&017)))==0)
- return(0);
- }
- oklabel:
- if (optexp==0)
- return(1);
- ct=curtoken;
- curtoken=tp;
- result=compute(&enodes[optexp]);
- curtoken=ct;
- return(result.e_v.e_con);
-}
-
-instance(instno,token) token_p token; {
- inst_p inp;
- int i;
- token_p tp;
- struct reginfo *rp;
- int regno;
- result_t result;
-
- if (instno==0) {
- token->t_token = 0;
- for(i=0;i<TOKENSIZE;i++)
- token->t_att[i].aw=0;
- return;
- }
- inp= &tokeninstances[instno];
- switch(inp->in_which) {
- default:
- assert(FALSE);
- case IN_COPY:
- tp= &fakestack[stackheight-inp->in_info[0]];
- if (inp->in_info[1]==0) {
- *token = *tp;
- } else {
- token->t_token= -1;
-#if MAXMEMBERS!=0
- if (tp->t_token == -1) {
- rp = &machregs[tp->t_att[0].ar];
- token->t_att[0].ar=rp->r_members[inp->in_info[1]-1];
- } else {
-#endif
- assert(tokens[tp->t_token].t_type[inp->in_info[1]-1] == EV_REG);
- token->t_att[0].ar=tp->t_att[inp->in_info[1]-1].ar;
-#if MAXMEMBERS!=0
- }
-#endif
- }
- return;
- case IN_RIDENT:
- token->t_token= -1;
- token->t_att[0].ar= inp->in_info[0];
- return;
-#ifdef REGVARS
- case IN_REGVAR:
- result=compute(&enodes[inp->in_info[0]]);
- i=isregvar((long)result.e_v.e_con);
- assert(i>0);
- token->t_token= -1;
- token->t_att[0].ar = i;
- return;
-#endif
- case IN_ALLOC:
- token->t_token= -1;
- regno=allreg[inp->in_info[0]];
-#if MAXMEMBERS!=0
- if (inp->in_info[1])
- regno=machregs[regno].r_members[inp->in_info[1]-1];
-#endif
- token->t_att[0].ar = regno;
- return;
- case IN_DESCR:
- token->t_token=inp->in_info[0];
- for (i=0;i<TOKENSIZE;i++)
- if (inp->in_info[i+1]==0) {
- assert(tokens[token->t_token].t_type[i]==0);
- token->t_att[i].aw=0;
- } else {
- result=compute(&enodes[inp->in_info[i+1]]);
- assert(tokens[token->t_token].t_type[i]==result.e_typ);
- if (result.e_typ==EV_INT)
- token->t_att[i].aw=result.e_v.e_con;
- else if (result.e_typ==EV_STR)
- token->t_att[i].as= result.e_v.e_str;
- else
- token->t_att[i].ar=result.e_v.e_reg;
- }
- return;
- }
-}
-
-cinstance(instno,token,tp,regno) token_p token,tp; {
- inst_p inp;
- int i;
- struct reginfo *rp;
- result_t result;
- int sh; /* saved stackheight */
-
- assert(instno!=0);
- inp= &tokeninstances[instno];
- switch(inp->in_which) {
- default:
- assert(FALSE);
- case IN_COPY:
- assert(inp->in_info[0] == 1);
- if (inp->in_info[1]==0) {
- *token = *tp;
- } else {
- token->t_token= -1;
-#if MAXMEMBERS!=0
- if (tp->t_token == -1) {
- rp = &machregs[tp->t_att[0].ar];
- token->t_att[0].ar=rp->r_members[inp->in_info[1]-1];
- } else {
-#endif
- assert(tokens[tp->t_token].t_type[inp->in_info[1]-1] == EV_REG);
- token->t_att[0].ar=tp->t_att[inp->in_info[1]-1].ar;
-#if MAXMEMBERS!=0
- }
-#endif
- }
- return;
- case IN_RIDENT:
- token->t_token= -1;
- token->t_att[0].ar= inp->in_info[0];
- return;
- case IN_ALLOC:
- token->t_token= -1;
- assert(inp->in_info[0]==0);
-#if MAXMEMBERS!=0
- if (inp->in_info[1])
- regno=machregs[regno].r_members[inp->in_info[1]-1];
-#endif
- token->t_att[0].ar = regno;
- return;
- case IN_DESCR:
- sh = stackheight;
- stackheight = tp - fakestack + 1;
- token->t_token=inp->in_info[0];
- for (i=0;i<TOKENSIZE;i++)
- if (inp->in_info[i+1]==0) {
- assert(tokens[token->t_token].t_type[i]==0);
- token->t_att[i].aw=0;
- } else {
- result=compute(&enodes[inp->in_info[i+1]]);
- assert(tokens[token->t_token].t_type[i]==result.e_typ);
- if (result.e_typ==EV_INT)
- token->t_att[i].aw=result.e_v.e_con;
- else if (result.e_typ==EV_STR)
- token->t_att[i].as= result.e_v.e_str;
- else
- token->t_att[i].ar=result.e_v.e_reg;
- }
- stackheight = sh;
- return;
- }
-}
-
-eqtoken(tp1,tp2) token_p tp1,tp2; {
- register i;
- register tkdef_p tdp;
-
- if (tp1->t_token!=tp2->t_token)
- return(0);
- if (tp1->t_token==0)
- return(1);
- if (tp1->t_token==-1) {
- if (tp1->t_att[0].ar!=tp2->t_att[0].ar)
- return(0);
- return(1);
- }
- tdp = &tokens[tp1->t_token];
- for (i=0;i<TOKENSIZE;i++)
- switch(tdp->t_type[i]) {
- default:
- return(1);
- case EV_INT:
- if (tp1->t_att[i].aw != tp2->t_att[i].aw)
- return(0);
- break;
- case EV_REG:
- if (tp1->t_att[i].ar != tp2->t_att[i].ar)
- return(0);
- break;
- case EV_STR:
- if (strcmp(tp1->t_att[i].as, tp2->t_att[i].as))
- return(0);
- break;
- }
- return(1);
-}
-
-distance(cindex) {
- register char *bp;
- register i;
- register token_p tp;
- int tokexp,tpl;
- int expsize,toksize,exact;
- int xsekt=0;
-
- bp = &coderules[cindex];
- switch( (*bp)&037 ) {
- default:
- return(stackheight==0 ? 0 : 100);
- case DO_MATCH:
- break;
- case DO_XXMATCH:
- xsekt++;
- case DO_XMATCH:
- xsekt++;
- break;
- }
- tpl= ((*bp++)>>5)&07;
- if (stackheight < tpl) {
- if (xsekt)
- return(MAXINT);
- tpl = stackheight;
- } else
- if (stackheight != tpl && xsekt==2)
- return(MAXINT);
- exact=0;
- tp= &fakestack[stackheight-1];
- for (i=0;i<tpl;i++,tp--) {
- getint(tokexp,bp);
- if (!match(tp, &machsets[tokexp], 0)) {
- if (xsekt)
- return(MAXINT);
- expsize = ssize(tokexp);
- toksize = tsize(tp);
- if (expsize>toksize)
- return(100);
- if (expsize<toksize)
- return(99-i);
- } else
- exact++;
- }
- if (exact==tpl) {
- if (xsekt)
- return(0);
- return(10-exact);
- }
- return(20-exact);
-}
-
-unsigned costcalc(cost) cost_t cost; {
- result_t result1,result2;
- extern unsigned cc1,cc2,cc3,cc4;
-
- result1=compute(&enodes[cost.c_size]);
- result2=compute(&enodes[cost.c_time]);
- assert(result1.e_typ == EV_INT && result2.e_typ == EV_INT);
- return(result1.e_v.e_con*cc1/cc2 + result2.e_v.e_con*cc3/cc4);
-}
-
-ssize(tokexpno) {
-
- return(machsets[tokexpno].set_size);
-}
-
-tsize(tp) register token_p tp; {
-
- if (tp->t_token==-1)
- return(machregs[tp->t_att[0].ar].r_size);
- return(tokens[tp->t_token].t_size);
-}
-
-#ifdef MAXSPLIT
-instsize(tinstno,tp) token_p tp; {
- inst_p inp;
- struct reginfo *rp;
-
- inp = &tokeninstances[tinstno];
- switch(inp->in_which) {
- default:
- assert(FALSE);
- case IN_COPY:
- assert(inp->in_info[0]==1);
-#if MAXMEMBERS!=0
- if (inp->in_info[1]==0)
-#endif
- return(tsize(tp));
-#if MAXMEMBERS!=0
- else {
- assert(tp->t_token == -1);
- rp = &machregs[tp->t_att[0].ar];
- return(machregs[rp->r_members[inp->in_info[1]-1]].r_size);
- }
-#endif
- case IN_RIDENT:
- return(machregs[inp->in_info[0]].r_size);
- case IN_ALLOC:
- assert(FALSE); /* cannot occur in splitting coercion */
- case IN_DESCR:
- return(tokens[inp->in_info[0]].t_size);
- }
-}
-#endif MAXSPLIT
-
-tref(tp,amount) register token_p tp; {
- register i;
- register tkdef_p tdp;
-
- if (tp->t_token==-1)
- chrefcount(tp->t_att[0].ar,amount,FALSE);
- else {
- tdp= &tokens[tp->t_token];
- for(i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG)
- chrefcount(tp->t_att[i].ar,amount,FALSE);
- }
-}
-
-#define MAXSAVE 10
-
-#ifdef MAXSPLIT
-split(tp,ip,ply,toplevel) token_p tp; int *ip; {
- c2_p cp;
- token_t savestack[MAXSAVE];
- int ok;
- register i;
- int diff;
- token_p stp;
- int tpl;
-
- for (cp=c2coercs;cp< &c2coercs[NC2]; cp++) {
- if (!match(tp,&machsets[cp->c2_texpno],0))
- continue;
- ok=1;
- for (i=0; ok && i<cp->c2_nsplit;i++) {
- if (ip[i]==0)
- goto found;
- if (instsize(cp->c2_repl[i],tp) != ssize(ip[i]))
- ok=0;
- }
- goto found;
- }
- return(0);
-found:
- assert(stackheight+cp->c2_nsplit-1<MAXFSTACK);
- stp = &fakestack[stackheight-1];
- diff = stp - tp;
- assert(diff<=MAXSAVE);
- for (i=1;i<=diff;i++)
- savestack[i-1] = tp[i]; /* save top of stack */
- stackheight -= diff;
- tpl = tokpatlen;
- tokpatlen = 1;
- codegen(&coderules[cp->c2_codep],ply,toplevel,MAXINT,0);
- tokpatlen = tpl;
- for (i=0;i<diff;i++) /* restore top of stack */
- fakestack[stackheight++] = savestack[i];
- return(cp->c2_nsplit);
-}
-#endif MAXSPLIT
-
-unsigned docoerc(tp,cp,ply,toplevel,forced) token_p tp; c3_p cp; {
- token_t savestack[MAXSAVE];
- token_p stp;
- int i,diff;
- unsigned cost;
- int tpl; /* saved tokpatlen */
-
- stp = &fakestack[stackheight-1];
- diff = stp -tp;
- assert(diff<=MAXSAVE);
- for (i=1;i<=diff;i++)
- savestack[i-1] = tp[i];
- stackheight -= diff;
- tpl = tokpatlen;
- tokpatlen = 1;
- cost = codegen(&coderules[cp->c3_codep],ply,toplevel,MAXINT,forced);
- tokpatlen = tpl;
- for (i=0;i<diff;i++)
- fakestack[stackheight++] = savestack[i];
- nallreg = 0;
- return(cost);
-}
-
-unsigned stackupto(limit,ply,toplevel) token_p limit; {
- token_t savestack[MAXFSTACK];
- token_p stp;
- int i,diff;
- int tpl; /* saved tokpatlen */
- int nareg; /* saved nareg */
- int areg[MAXALLREG];
- c1_p cp;
- register token_p tp;
- unsigned totalcost=0;
- struct reginfo *rp,**rpp;
-
- for (tp=fakestack;tp<=limit;limit--) {
- for (cp=c1coercs;cp< &c1coercs[NC1]; cp++) {
- if (match(tp,&machsets[cp->c1_texpno],cp->c1_expr)) {
- if (cp->c1_prop>=0) {
- for (rpp=reglist[cp->c1_prop];
- (rp = *rpp)!=0 &&
- getrefcount(rp-machregs)!=0;
- rpp++)
- ;
- if (rp==0)
- continue;
- /* look for other possibility */
- }
- stp = &fakestack[stackheight-1];
- diff = stp -tp;
- assert(diff<=MAXFSTACK);
- for (i=1;i<=diff;i++)
- savestack[i-1] = tp[i];
- stackheight -= diff;
- tpl = tokpatlen;
- tokpatlen = 1;
- nareg = nallreg;
- for (i=0;i<nareg;i++)
- areg[i] = allreg[i];
- if (cp->c1_prop>=0) {
- nallreg=1; allreg[0] = rp-machregs;
- chrefcount(allreg[0],1,FALSE);
- } else
- nallreg=0;
- totalcost+= codegen(&coderules[cp->c1_codep],ply,toplevel,MAXINT,0);
- totalcost+= costcalc(cp->c1_cost);
- tokpatlen = tpl;
- for (i=0;i<diff;i++)
- fakestack[stackheight++] = savestack[i];
- nallreg=nareg;
- for (i=0;i<nareg;i++)
- allreg[i] = areg[i];
- goto contin;
- }
- }
- assert(FALSE);
- contin: ;
- }
- return(totalcost);
-}
-
-c3_p findcoerc(tp,tep) token_p tp; set_p tep; {
- register c3_p cp;
- token_t rtoken;
- register i;
- register struct reginfo **rpp;
-
- for (cp=c3coercs;cp< &c3coercs[NC3]; cp++) {
- if (tp!=(token_p) 0) {
- if (!match(tp,&machsets[cp->c3_texpno],0))
- continue;
- } else {
- if (cp->c3_texpno!=0)
- continue;
- }
- if (cp->c3_prop==0) { /* no reg needed */
- cinstance(cp->c3_repl,&rtoken,tp,0);
- if (match(&rtoken,tep,0))
- return(cp);
- } else {
- curreglist = (rl_p) myalloc(sizeof (rl_t));
- curreglist->rl_n = 0;
- for (rpp=reglist[cp->c3_prop];*rpp;rpp++) {
- i = *rpp - machregs;
- cinstance(cp->c3_repl,&rtoken,tp,i);
- if (match(&rtoken,tep,0))
- curreglist->rl_list[curreglist->rl_n++] = i;
- }
- if (curreglist->rl_n != 0)
- return(cp);
- myfree(curreglist);
- }
- }
- return(0); /* nothing found */
-}
-
-
-error(s,a1,a2,a3,a4) char *s; {
-
- fatal(s,a1,a2,a3,a4);
-}
-
-fatal(s,a1,a2,a3,a4) char *s; {
-
- fprintf(stderr,"Error: ");
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
- out_finish();
- abort();
- exit(-1);
-}
-
-#ifndef NDEBUG
-badassertion(asstr,file,line) char *asstr, *file; {
-
- fatal("Assertion \"%s\" failed %s(%d)",asstr,file,line);
-}
-#endif
-
-max(a,b) {
-
- return(a>b ? a : b);
-}
+++ /dev/null
-/* $Header$ */
-
-#ifndef EM_WSIZE
-EM_WSIZE should be defined at this point
-#endif
-#ifndef EM_PSIZE
-EM_PSIZE should be defined at this point
-#endif
-#if EM_WSIZE>4 || EM_PSIZE>4
-Implementation will not be correct unless a long integer
-has more then 4 bytes of precision.
-#endif
-
-typedef char byte;
-typedef char * string;
-
-#if EM_WSIZE>2 || EM_PSIZE>2
-#define full long
-#else
-#define full int
-#endif
-
-#if EM_WSIZE>2
-#define word long
-#ifndef WRD_FMT
-#define WRD_FMT "%D"
-#endif WRD_FMT
-#else
-#define word int
-#ifndef WRD_FMT
-#define WRD_FMT "%d"
-#endif WRD_FMT
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-int stackheight = 0;
-token_t fakestack[MAXFSTACK];
-int nallreg = 0;
-int allreg[MAXALLREG];
-token_p curtoken = (token_p) 0;
-result_t dollar[LONGESTPATTERN];
-int nemlines =0;
-struct emline emlines[MAXEMLINES];
-struct emline *emp=emlines;
-struct emline *saveemp;
-int tokpatlen;
-rl_p curreglist;
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-Makefile
-ack.h
-data.c
-data.h
-dmach.c
-dmach.h
-files.c
-grows.c
-grows.h
-intable.c
-list.c
-list.h
-main.c
-malloc.c
-mktables.c
-pc
-rmach.c
-run.c
-scan.c
-svars.c
-trans.c
-trans.h
-util.c
+++ /dev/null
-HFILES=ack.h list.h trans.h data.h dmach.h grows.h
-DSRC=list.c data.c main.c scan.c svars.c trans.c util.c rmach.c run.c grows.c\
- files.c
-ISRC=dmach.c intable.c
-OBJ=list.o data.o main.o scan.o svars.o trans.o util.o rmach.o run.o \
- dmach.o intable.o grows.o files.o
-ACKDIR=../../lib/ack
-FE=fe
-INTABLES=pdp int
-LNTABLES=6500 m68k2 m68k4 6809 8080 acc apc nascom vax2 vax4 z80 i86
-CFLAGS=-O -n
-BINDIR=../../bin
-
-head: ack
-
-install: ack
- cp ack $(BINDIR)/ack
- -cd $(BINDIR) ; \
- for i in $(INTABLES) $(LNTABLES) ; do ln ack $$i ; done
- (cd pc ; make install )
-
-cmp: ack
- cmp ack $(BINDIR)/ack
- (cd pc ; make cmp )
-
-clean:
- -rm -f *.old *.o ack
- (cd pc ; make clean )
-
-ack: $(OBJ)
- $(CC) -o ack $(CFLAGS) $(OBJ)
-
-grows.o files.o list.o run.o \
-data.o main.o scan.o trans.o rmach.o util.o : ack.h list.h
-
-files.o data.o main.o scan.o run.o trans.o rmach.o: trans.h data.h
-
-files.o rmach.o trans.o grows.c : grows.h
-
-rmach.c: dmach.h
-
-files.o main.o rmach.o : ../../h/em_path.h
-
-main.o : ../../h/local.h
-
-malloc.o svars.o: ack.h
-
-dmach.c intable.c: mktables dmach.h
- : mktables $(ACKDIR) # $(FE) $(INTABLES)
- mktables $(ACKDIR)
-
-mktables: mktables.c
- cc -o mktables mktables.c
-
-pr:
- @pr Makefile $(HFILES) $(DSRC) $(ACKDIR)/*
- @(cd pc ; make pr)
-
-opr:
- make pr | opr
-
-lint: $(ISRC)
- lint -hbx $(DSRC) $(ISRC)
+++ /dev/null
-/****************************************************************************/
-/* User settable options */
-/****************************************************************************/
-
-#define FRONTENDS "fe" /* The front-end definitions */
-#define ACKNAME "AckXXXXXX" /* Handed to mktemp for temp. files */
-
-/****************************************************************************/
-/* Internal mnemonics, should not be tinkered with */
-/****************************************************************************/
-
-/* The names of some string variables */
-
-#define HOME "EM"
-#define RTS "RTS"
-#define NEEDS "NEEDS"
-#define HEAD "HEAD"
-#define TAIL "TAIL"
-#define SRC "SOURCE"
-#define LIBVAR "LNAME"
-
-/* Intended for flags, possibly in bit fields */
-
-#define YES 1
-#define NO 0
-#define MAYBE 2
-
-#define EXTERN extern
-
-#define SUFCHAR '.' /* Start of SUFFIX in file name */
-#define SPACE ' '
-#define TAB '\t'
-#define EQUAL '='
-#define S_VAR '{' /* Start of variable */
-#define C_VAR '}' /* End of variable */
-#define A_VAR '?' /* Variable alternative */
-#define BSLASH '\\' /* Backslash */
-#define STAR '*' /* STAR */
-#define C_IN '<' /* Token specifying input */
-#define C_OUT '>' /* Token specifying output */
-#define S_EXPR '(' /* Start of expression */
-#define C_EXPR ')' /* End of expression */
-#define M_EXPR ':' /* Middle of two suffix lists */
-#define T_EXPR '=' /* Start of tail */
-
-#define NO_SCAN 0200 /* Bit set in character to defeat recogn. */
-
-typedef struct {
- char *p_path; /* points to the full pathname */
- int p_keeps:1; /* The string should be thrown when unused */
- int p_keep:1; /* The file should be thrown away after use */
-} path ;
-
-/* Return values of setpath() */
-enum f_path { F_OK, F_NOMATCH, F_NOPATH } ;
-
-/* Library routines */
-
-extern char *index();
-extern char *rindex();
-extern char *strcpy();
-extern char *strcat();
-extern char *mktemp();
-extern int unlink();
-extern int close();
-extern int open();
-extern int creat();
-
-/* Own routines */
-enum f_path setpath();
-enum f_path scan_end();
-extern int noodstop();
-extern char *getvar();
-extern char *keeps();
-extern char *basename();
-extern char *skipblank();
-extern char *firstblank();
-extern char *getcore();
-extern char *changecore();
-#define freecore(area) free(area)
-
-/* #define DEBUG 1 /* Allow debugging of Ack */
-
-#ifndef DEBUG
-# define debug 0 /* To surprise all these 'if ( debug ) 's */
-#else
-extern int debug ;
-#endif
+++ /dev/null
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-
-
-#undef EXTERN
-#define EXTERN
-
-#include "data.h"
+++ /dev/null
-EXTERN char *stopsuffix; /* Suffix to stop at */
-EXTERN char *machine; /* The machine id */
-EXTERN char *rts; /* The runtime-system id */
-
-EXTERN list_head arguments; /* List of arguments */
-EXTERN list_head flags; /* List of flags */
-
-EXTERN list_head c_arguments; /* List of linker arguments */
-
-EXTERN list_head tr_list; /* List of transformations */
-
-EXTERN list_head R_list; /* List of -R flags */
-EXTERN list_head head_list; /* List of suffices for headers */
-EXTERN list_head tail_list; /* List of suffices for tails */
-
-EXTERN int k_flag; /* Like -k of lint */
-EXTERN int g_flag; /* do_run() */
-EXTERN int t_flag; /* Preserve intermediate files */
-EXTERN int v_flag; /* Verbose */
-EXTERN int w_flag; /* Don't print warnings */
-EXTERN int nill_flag; /* Don't file names */
-EXTERN int Optflag; /* Optimizing */
-
-#ifdef DEBUG
-EXTERN int debug; /* Debugging control */
-#endif
-
-EXTERN int n_error; /* Number of errors encountered */
-
-EXTERN char *progname; /* The program call name */
-
-EXTERN char *outfile; /* The result file e.g. a.out */
-EXTERN char *template; /* The template for temporary file
- names */
-
-EXTERN trf *combiner; /* Pointer to the Loader/Linker */
-EXTERN trf *cpp_trafo; /* Pointer to C-preprocessor */
-
-EXTERN path in; /* The current input pathname */
-EXTERN path out; /* The current output pathname */
-EXTERN path orig; /* The original input path */
-EXTERN char *p_basename; /* The current basename */
-EXTERN char *p_suffix; /* The current input suffix */
+++ /dev/null
-/***************************************************************/
-/* */
-/* Definition for table that maps a name on an intable index */
-/* */
-/***************************************************************/
-
-
-typedef struct {
- char *ma_name ; /* The name of the machine */
- int ma_index ;
-} dmach ;
-
-extern dmach massoc[] ;
-
-extern char intable[] ;
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "grows.h"
-#include "data.h"
-#include "../../h/em_path.h"
-
-setfiles(phase) register trf *phase ; {
- /* Set the out structure according to the in structure,
- the transformation and some global data */
- growstring pathname ;
- register list_elem *elem ;
-
- if ( phase->t_combine ) {
- out.p_keep=YES ;
- out.p_path=outfile ;
- out.p_keeps=NO ;
- in.p_path= (char *)0 ;
- in.p_keep=YES ;
- in.p_keeps=NO ;
- } else {
- gr_init(&pathname) ;
- if ( !phase->t_keep && !t_flag ) {
- gr_cat(&pathname,TMP_DIR) ;
- gr_cat(&pathname,"/") ;
- gr_cat(&pathname,template) ;
- out.p_keep=NO ;
- } else {
- gr_cat(&pathname,p_basename) ;
- out.p_keep=YES ;
- }
- gr_cat(&pathname,phase->t_out) ;
- out.p_path= gr_final(&pathname) ;
- out.p_keeps= YES ;
- }
- scanlist( l_first(arguments), elem) {
- if ( strcmp(l_content(*elem),out.p_path)==0 ) {
- error("attempt to overwrite argument file") ;
- return 0 ;
- }
- }
- return 1 ;
-}
-
-disc_files() {
- if ( in.p_path ) {
- if ( !in.p_keep ) {
- if ( unlink(in.p_path)!=0 ) {
- werror("couldn't unlink %s",in.p_path);
- }
- }
- if ( in.p_keeps ) throws(in.p_path) ;
- }
- in=out ;
- out.p_path= (char *)0 ;
- out.p_keeps=NO ;
- out.p_keep=NO ;
-}
-
-rmtemps() {
- /* Called in case of disaster, always remove the current output file!
- */
- if ( out.p_path ) {
- unlink(out.p_path) ;
- if ( out.p_keeps ) throws(out.p_path) ;
- out.p_path= (char *)0 ;
- out.p_keeps=NO ;
- out.p_keep=NO ;
- }
- if ( !in.p_keep && in.p_path ) {
- unlink(in.p_path) ;
- if ( in.p_keeps ) throws(in.p_path) ;
- in.p_path= (char *)0 ;
- out.p_keeps= NO ;
- out.p_keep=NO ;
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/**************************************************************************/
-/* */
-/* Bookkeeping for growing strings */
-/* */
-/**************************************************************************/
-
-#include "ack.h"
-#include "grows.h"
-
-gr_add(id,c) register growstring *id ; char c ; {
- if ( id->gr_size==id->gr_max) {
- if ( id->gr_size==0 ) { /* The first time */
- id->gr_max= 2*GR_MORE ;
- id->gr_string= getcore(id->gr_max) ;
- } else {
- id->gr_max += GR_MORE ;
- id->gr_string= changecore(id->gr_string,id->gr_max ) ;
- }
- }
- *(id->gr_string+id->gr_size++)= c ;
-}
-
-gr_cat(id,string) growstring *id ; char *string ; {
- register char *ptr ;
-
-#ifdef DEBUG
- if ( id->gr_size && *(id->gr_string+id->gr_size-1) ) {
- vprint("Non-zero terminated %*s\n",
- id->gr_size, id->gr_string ) ;
- }
-#endif
- if ( id->gr_size ) id->gr_size-- ;
- ptr=string ;
- for (;;) {
- gr_add(id,*ptr) ;
- if ( *ptr++ ) continue ;
- break ;
- }
-}
-
-gr_throw(id) register growstring *id ; {
- /* Throw the string away */
- if ( id->gr_max==0 ) return ;
- freecore(id->gr_string) ;
- id->gr_max=0 ;
- id->gr_size=0 ;
-}
-
-gr_init(id) growstring *id ; {
- id->gr_size=0 ; id->gr_max=0 ;
-}
-
-char *gr_final(id) growstring *id ; {
- /* Throw away the bookkeeping, adjust the string to its final
- length and return a pointer to a string to be get rid of with
- throws
- */
- register char *retval ;
- retval= keeps(gr_start(*id)) ;
- gr_throw(id) ;
- return retval ;
-}
+++ /dev/null
-/* struct used to identify and do bookkeeping for growing strings */
-
-typedef struct {
- char *gr_string ; /* Points to start of string */
- unsigned gr_size ; /* Current string size */
- unsigned gr_max ; /* Maximum string size */
-} growstring ;
-
-#define GR_MORE 50 /* Steps to grow */
-
-#define gr_start(id) (id).gr_string /* The start of the string */
-
-/* Routines used */
-
-extern int gr_throw() ; /* To free the core */
-extern int gr_add() ; /* To add one character */
-extern int gr_cat() ; /* concatenate the contents and the string */
-extern int gr_init() ; /* Initialize the bookkeeping */
-extern char *gr_final() ; /* Transform to a stable storage string */
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-
-/* List handling, operations allowed:
- adding strings to the list,
- throwing away whole lists,
- linearize a list.
-
-Routines:
- l_add(header,string) Add an element to a list.
- header List header, list_head *
- string String pointer, char *
- the string is NOT copied
-
- l_clear(header) Delete an whole list.
- header List header, list_head *
-
-*/
-
-
-l_add(header,string) list_head *header ; char *string ; {
- register list_elem *new;
-
- /* NOSTRICT */
- new= (list_elem *)getcore(sizeof *new);
- l_content(*new)= string ;
- /* NOSTRICT */
- l_next(*new)= (list_elem *)0 ;
- if ( !header->ca_first ) {
- header->ca_first= new ;
- } else {
- header->ca_last->ca_next= new ;
- }
- header->ca_last= new ;
-}
-
-l_clear(header) list_head *header ; {
- register list_elem *old, *next;
- for ( old=header->ca_first ; old ; old= next ) {
- next= old->ca_next ;
- freecore((char *)old) ;
- }
- header->ca_first= (list_elem *) 0 ;
- header->ca_last = (list_elem *) 0 ;
-}
-
-l_throw(header) list_head *header ; {
- register list_elem *old, *next;
- for ( old=header->ca_first ; old ; old= next ) {
- throws(l_content(*old)) ;
- next= old->ca_next ;
- freecore((char *)old) ;
- }
- header->ca_first= (list_elem *) 0 ;
- header->ca_last = (list_elem *) 0 ;
-}
+++ /dev/null
-struct ca_elem {
- struct ca_elem *ca_next; /* The link */
- char *ca_cont; /* The contents */
-} ;
-
-struct ca_list {
- struct ca_elem *ca_first; /* The head */
- struct ca_elem *ca_last; /* The tail */
-} ;
-
-typedef struct ca_list list_head ; /* The decl. for headers */
-typedef struct ca_elem list_elem ; /* The decl. for elements */
-
-/* Some operations */
-
-/* Access */
-#define l_first(header) (header).ca_first
-#define l_next(elem) (elem).ca_next
-#define l_content(elem) (elem).ca_cont
-
-/* To be used for scanning lists, ptr is the running variable */
-#define scanlist(elem,ptr) \
- for ( ptr= elem ; ptr; ptr= l_next(*ptr) )
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "../../h/em_path.h"
-#include "../../h/local.h"
-#include "data.h"
-#include <signal.h>
-
-static int sigs[] = { SIGINT, SIGHUP, SIGTERM, 0 } ;
-
-extern char *getenv();
-
-main(argc,argv) char **argv ; {
- register list_elem *elem ;
- register char *frontend ;
- register int *n_sig ;
-
- progname=argv[0];
- varinit();
- vieuwargs(argc,argv);
- if ( (frontend=getenv("ACKFE")) ) {
- setlist(frontend) ;
- } else {
- setlist(FRONTENDS);
- }
- setlist(machine);
- transini();
- scanneeds();
- template= mktemp(ACKNAME) ;
- if ( n_error && !k_flag ) return n_error ;
-
- for ( n_sig=sigs ; *n_sig ; n_sig++ ) {
- if ( signal(*n_sig,noodstop)==SIG_IGN ) {
- signal(*n_sig,SIG_IGN) ;
- }
- }
- scanlist ( l_first(arguments), elem ) {
- if ( !process(l_content(*elem)) && !k_flag ) return 1 ;
- }
- orig.p_path= (char *)0 ;
-
- if ( !combiner && !stopsuffix ) {
- /* Call combiner directly without any transformation */
- scanlist(l_first(tr_list),elem) {
- if ( t_cont(*elem)->t_combine ) {
- combiner= t_cont(*elem) ;
- }
- }
- }
-
- if ( !combiner || n_error ) return n_error ;
-
- if ( !do_combine() ) return 1 ;
-
- if ( g_flag ) {
- return do_run();
- }
-
- return 0 ;
-}
-
-char *srcvar() {
- return orig.p_path ;
-}
-
-varinit() {
- /* initialize the string variables */
- setsvar(keeps(HOME),keeps(EM_DIR)) ;
- setpvar(keeps(SRC),srcvar) ;
-}
-
-/************************* flag processing ***********************/
-
-vieuwargs(argc,argv) char **argv ; {
- register char *argp;
- register int nextarg ;
- register int eaten ;
-
- firstarg(argv[0]) ;
-
- nextarg= 1 ;
-
- while ( nextarg<argc ) {
- argp= argv[nextarg] ;
- nextarg++ ;
- if ( argp[0]!='-' || argp[1]=='l' ) {
- /* Not a flag, or a library */
- l_add(&arguments,argp) ;
- continue ;
- }
-
- /* Flags */
- eaten=0 ; /* Did not 'eat' tail of flag yet */
- switch ( argp[1] ) {
- case 'm': if ( machine ) fuerror("Two machines?") ;
- machine= &argp[2];
- eaten=1 ;
- break ;
- case 'o': if ( nextarg>=argc ) {
- fuerror("-o can't be the last flag") ;
- }
- if ( outfile ) fuerror("Two results?") ;
- outfile= argv[nextarg++] ;
- break ;
- case 'O': Optflag++ ;
- break ;
- case 'v': v_flag++ ;
- break ;
- case 'g': g_flag++ ;
- break ;
- case 'c': if ( stopsuffix ) fuerror("Two -c flags") ;
- stopsuffix= &argp[2]; eaten=1;
- if ( *stopsuffix && *stopsuffix!=SUFCHAR ) {
- fuerror("-c flag has invalid tail") ;
- }
- break ;
- case 'k': k_flag++ ;
- break ;
- case 't': t_flag++ ;
- break ;
- case 'R': do_Rflag(argp); eaten=1;
- break ;
- case 'r': if ( argp[2]!=SUFCHAR ) {
- error("-r must be followed by %c",SUFCHAR) ;
- }
- keeptail(&argp[2]); eaten=1 ;
- break ;
- case '.': if ( rts ) fuerror("Two run-time systems?") ;
- rts= &argp[1] ; eaten=1;
- keephead(rts) ; keeptail(rts) ;
- break ;
-#ifdef DEBUG
- case 'd': debug++ ;
- break ;
-#endif
- case 0 : nill_flag++ ; eaten++ ;
- break;
- case 'w': { register char *tokeep ;
- w_flag++;
- tokeep=keeps(argp) ;
- *tokeep |= NO_SCAN ;
- l_add(&flags,tokeep) ;
- }
- break ;
- default: /* The flag is not recognized,
- put it on the list for the sub-processes
- */
-#ifdef DEBUG
- if ( debug ) {
- vprint("Flag %s: phase dependent\n",argp) ;
- }
-#endif
- l_add(&flags,keeps(argp)) ;
- eaten=1 ;
- }
- if ( argp[2] && !eaten ) {
- werror("Unexpected characters at end of %s",argp) ;
- }
- }
- if ( !machine && ! (machine=getenv("ACKM")) ) {
-#ifdef ACKM
- machine= ACKM; /* The default machine */
-#else
- fuerror("No machine specified") ;
-#endif
- }
- return ;
-}
-
-firstarg(argp) register char *argp ; {
- register char *name ;
-
- name=rindex(argp,'/') ;
- if ( name && *(name+1) ) {
- name++ ;
- } else {
- name= argp ;
- }
- if ( strcmp(name,"ack")==0 ) return ;
- if ( strcmp(name,"acc")==0 || strcmp(name,"cc")==0 ) {
- rts= ".c" ; keephead(rts) ; keeptail(rts) ;
- return ;
- }
- if ( strcmp(name,"apc")==0 || strcmp(name,"pc")==0 ) {
- rts= ".p" ; keephead(rts) ; keeptail(rts) ;
- return ;
- }
- machine= name;
-}
-
-/************************* argument processing ***********************/
-
-process(arg) char *arg ; {
- /* Process files & library arguments */
- register list_elem *elem ;
- register trf *phase ;
- int first=YES ;
-
-#ifdef DEBUG
- if ( debug ) vprint("Processing %s\n",arg) ;
-#endif
- if ( arg[0]=='-' ) { l_add(&c_arguments,keeps(arg)) ; return 1 ; }
- p_suffix= rindex(arg,SUFCHAR) ;
- if ( p_basename ) throws(p_basename) ;
- orig.p_keep= YES ; /* Don't throw away the original ! */
- orig.p_path= arg ;
- p_basename= keeps(basename(arg)) ;
- if ( !p_suffix ) { l_add(&c_arguments,keeps(arg)) ; return 1 ; }
- /* Try to find a path through the transformations */
- switch( setpath() ) {
- case F_NOPATH :
- error("Incomplete internal specification for %s",arg) ;
- l_add(&c_arguments,keeps(arg)) ;
- return 1 ;
- case F_NOMATCH :
- if ( stopsuffix ) werror("Unknown suffix in %s",arg) ;
- l_add(&c_arguments,keeps(arg)) ;
- return 1 ;
- case F_OK :
- break ;
- }
- orig.p_keeps= NO;
- in= orig ;
- scanlist(l_first(tr_list), elem) {
- phase= t_cont(*elem) ;
- if ( phase->t_do ) { /* perform this transformation */
- if ( first ) {
- if ( !nill_flag ) {
- printf("%s\n",arg) ;
- }
- switch ( phase->t_prep ) {
- default : if ( !mayprep() ) break ;
- case YES: if ( !transform(cpp_trafo) ) {
- n_error++ ;
-#ifdef DEBUG
- vprint("Pre-processor failed\n") ;
-#endif
- return 0 ;
- }
- case NO :
- break ;
- }
- }
- if ( cpp_trafo && stopsuffix &&
- strcmp(cpp_trafo->t_out,stopsuffix)==0 ) {
- break ;
- }
- if ( !transform(phase) ) {
- n_error++ ;
-#ifdef DEBUG
- if ( debug ) {
- vprint("phase %s for %s failed\n",
- phase->t_name,orig.p_path) ;
- }
-#endif
- return 0 ;
- }
- first=NO ;
- }
- }
-#ifdef DEBUG
- if ( debug ) vprint("Transformation complete for %s\n",orig.p_path) ;
-#endif
- if ( !in.p_keep ) fatal("attempt to discard the result file") ;
- l_add(&c_arguments,keeps(in.p_path));
- disc_files() ;
- return 1 ;
-}
-
-mayprep() {
- int file ;
- char fc ;
- file=open(in.p_path,0);
- if ( file<0 ) return 0 ;
- if ( read(file,&fc,1)!=1 ) fc=0 ;
- close(file) ;
- return fc=='#' ;
-}
-
-keephead(suffix) char *suffix ; {
- l_add(&head_list, suffix) ;
-}
-
-keeptail(suffix) char *suffix ; {
- l_add(&tail_list, suffix) ;
-}
-
-scanneeds() {
- register list_elem *elem ;
- scanlist(l_first(head_list), elem) { setneeds(l_content(*elem),0) ; }
- l_clear(&head_list) ;
- scanlist(l_first(tail_list), elem) { setneeds(l_content(*elem),1) ; }
- l_clear(&tail_list) ;
-}
-
-setneeds(suffix,tail) char *suffix ; {
- register list_elem *elem ;
- register trf *phase ;
-
- p_suffix= suffix ;
- switch ( setpath() ) {
- case F_OK :
- scanlist( l_first(tr_list), elem ) {
- phase = t_cont(*elem) ;
- if ( phase->t_do ) {
- if ( phase->t_needed ) {
- if ( tail )
- add_tail(phase->t_needed) ;
- else
- add_head(phase->t_needed) ;
- }
- }
- }
- break ;
- case F_NOMATCH :
- werror("\"%s\": unrecognized suffix",suffix) ;
- break ;
- case F_NOPATH :
- werror("incomplete internal specification for %s files",
- suffix) ;
- break ;
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-
-#include "ack.h"
-#ifdef DEBUG
-#define ASSERT(p) if(!(p))botch("p");else
-botch(s)
-char *s;
-{
- printf("malloc/free botched: %s\n",s);
- abort();
-}
-#else
-#define ASSERT(p)
-#endif
-
-/* avoid break bug */
-#ifdef pdp11
-#define GRANULE 64
-#else
-#define GRANULE 0
-#endif
-/* C storage allocator
- * circular first-fit strategy
- * works with noncontiguous, but monotonically linked, arena
- * each block is preceded by a ptr to the (pointer of)
- * the next following block
- * blocks are exact number of words long
- * aligned to the data type requirements of ALIGN
- * pointers to blocks must have BUSY bit 0
- * bit in ptr is 1 for busy, 0 for idle
- * gaps in arena are merely noted as busy blocks
- * last block of arena (pointed to by alloct) is empty and
- * has a pointer to first
- * idle blocks are coalesced during space search
- *
- * a different implementation may need to redefine
- * ALIGN, NALIGN, BLOCK, BUSY, INT
- * where INT is integer type to which a pointer can be cast
-*/
-#define INT int
-#define ALIGN int
-#define NALIGN 1
-#define WORD sizeof(union store)
-#define BLOCK 1024 /* a multiple of WORD*/
-#define BUSY 1
-#define NULL 0
-#define testbusy(p) ((INT)(p)&BUSY)
-#define setbusy(p) (union store *)((INT)(p)|BUSY)
-#define clearbusy(p) (union store *)((INT)(p)&~BUSY)
-
-union store { union store *ptr;
- ALIGN dummy[NALIGN];
- int calloc; /*calloc clears an array of integers*/
-};
-
-static union store allocs[2]; /*initial arena*/
-static union store *allocp; /*search ptr*/
-static union store *alloct; /*arena top*/
-static union store *allocx; /*for benefit of realloc*/
-char *sbrk();
-
-char *
-malloc(nbytes)
-unsigned nbytes;
-{
- register union store *p, *q;
- register nw;
- static temp; /*coroutines assume no auto*/
-
- if(allocs[0].ptr==0) { /*first time*/
- allocs[0].ptr = setbusy(&allocs[1]);
- allocs[1].ptr = setbusy(&allocs[0]);
- alloct = &allocs[1];
- allocp = &allocs[0];
- }
- nw = (nbytes+WORD+WORD-1)/WORD;
- ASSERT(allocp>=allocs && allocp<=alloct);
- ASSERT(allock());
- for(p=allocp; ; ) {
- for(temp=0; ; ) {
- if(!testbusy(p->ptr)) {
- while(!testbusy((q=p->ptr)->ptr)) {
- ASSERT(q>p&&q<alloct);
- p->ptr = q->ptr;
- }
- if(q>=p+nw && p+nw>=p)
- goto found;
- }
- q = p;
- p = clearbusy(p->ptr);
- if(p>q)
- ASSERT(p<=alloct);
- else if(q!=alloct || p!=allocs) {
- ASSERT(q==alloct&&p==allocs);
- return(NULL);
- } else if(++temp>1)
- break;
- }
- temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD);
- q = (union store *)sbrk(0);
- if(q+temp+GRANULE < q) {
- return(NULL);
- }
- q = (union store *)sbrk(temp*WORD);
- if((INT)q == -1) {
- return(NULL);
- }
- ASSERT(q>alloct);
- alloct->ptr = q;
- if(q!=alloct+1)
- alloct->ptr = setbusy(alloct->ptr);
- alloct = q->ptr = q+temp-1;
- alloct->ptr = setbusy(allocs);
- }
-found:
- allocp = p + nw;
- ASSERT(allocp<=alloct);
- if(q>allocp) {
- allocx = allocp->ptr;
- allocp->ptr = p->ptr;
- }
- p->ptr = setbusy(allocp);
- return((char *)(p+1));
-}
-
-/* freeing strategy tuned for LIFO allocation
-*/
-free(ap)
-register char *ap;
-{
- register union store *p = (union store *)ap;
-
- ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct);
- ASSERT(allock());
- allocp = --p;
- ASSERT(testbusy(p->ptr));
- p->ptr = clearbusy(p->ptr);
- ASSERT(p->ptr > allocp && p->ptr <= alloct);
-}
-
-/* realloc(p, nbytes) reallocates a block obtained from malloc()
- * and freed since last call of malloc()
- * to have new size nbytes, and old content
- * returns new location, or 0 on failure
-*/
-
-char *
-realloc(p, nbytes)
-register union store *p;
-unsigned nbytes;
-{
- register union store *q;
- union store *s, *t;
- register unsigned nw;
- unsigned onw;
-
- if(testbusy(p[-1].ptr))
- free((char *)p);
- onw = p[-1].ptr - p;
- q = (union store *)malloc(nbytes);
- if(q==NULL || q==p)
- return((char *)q);
- s = p;
- t = q;
- nw = (nbytes+WORD-1)/WORD;
- if(nw<onw)
- onw = nw;
- while(onw--!=0)
- *t++ = *s++;
- if(q<p && q+nw>=p)
- (q+(q+nw-p))->ptr = allocx;
- return((char *)q);
-}
-
-#ifdef DEBUG
-allock()
-{
-#ifdef DEBUG
- register union store *p;
- int x;
- x = 0;
- for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) {
- if(p==allocp)
- x++;
- }
- ASSERT(p==alloct);
- return(x==1|p==allocp);
-#else
- return(1);
-#endif
-}
-#endif
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include <stdio.h>
-#include <ctype.h>
-
-char *fname = 0 ;
-char dname[200] ;
-char *tail ;
-
-FILE *intab ;
-FILE *dmach ;
-
-int index ;
-
-main(argc,argv) char **argv ; {
- register i ;
-
- start(argv[1]) ;
- for ( i=2 ; i<argc ; i++ ) {
- fname= argv[i] ;
- readm() ;
- }
- stop(argc>2) ;
- return 0 ;
-}
-
-start(dir) char *dir ; {
- tail= dname ;
- while ( *dir ) {
- *tail++ = *dir ++ ;
- }
- if ( tail!=dname ) *tail++= '/' ;
- index=0 ;
- intab= fopen("intable.c","w");
- dmach= fopen("dmach.c","w");
- if ( intab==NULL || dmach==NULL ) {
- fprintf(stderr,"Couln't create output file(s)\n");
- exit ( 1) ;
- }
- fprintf(dmach,"#include \"dmach.h\"\n\ndmach\tmassoc[] = {\n") ;
- fprintf(intab,"char intable[] = {\n") ;
-}
-
-stop(filled) {
- fprintf(dmach,"\t{\"\",\t-1\t}\n} ;\n") ;
- if ( !filled ) fprintf(intab,"\t0\n") ;
- fprintf(intab,"\n} ;\n") ;
- fclose(dmach); fclose(intab) ;
-}
-
-FILE *do_open(file) char *file ; {
- strcpy(tail,file) ;
- return fopen(dname,"r") ;
-}
-
-readm() {
- register int i ;
- register int token ;
- register FILE *in ;
-
- in=do_open(fname) ;
- if ( in==NULL ) {
- fprintf(stderr,"Cannot open %s\n",fname) ;
- return ;
- }
- i=0 ;
- fprintf(dmach,"\t{\"%s\",\t%d\t},\n",fname,index) ;
- fprintf(intab,"\n/* %s */\n\t",fname) ;
- for (;;) {
- token=getc(in) ;
- index++ ;
- if ( ++i == 10 ) {
- fprintf(intab,"\n\t") ;
- i=0 ;
- } else {
- fprintf(intab," ") ;
- }
- if ( !isascii(token) || !(isprint(token) || isspace(token)) ){
- if ( token!=EOF ) {
- fprintf(stderr,"warning: non-ascii in %s\n",fname) ;
- fprintf(intab,"%4d,",token) ;
- } else {
- fprintf(intab," 0,",token) ;
- break ;
- }
- } else if ( isprint(token) ) {
- switch ( token ) {
- case '\'': fprintf(intab,"'\\''") ; break ;
- case '\\': fprintf(intab,"'\\\\'") ; break ;
- default: fprintf(intab," '%c'",token) ; break ;
- }
- } else switch ( token ) {
- case '\n' : fprintf(intab,"'\\n'") ; break ;
- case '\t' : fprintf(intab,"'\\t'") ; break ;
- case '\r' : fprintf(intab,"'\\r'") ; break ;
- case '\f' : fprintf(intab,"'\\f'") ; break ;
- case ' ' : fprintf(intab," ' '") ; break ;
- default : fprintf(stderr,"warning: unrec. %d\n",
- token) ;
- fprintf(intab,"%4d",token) ;
- break ;
- }
- fprintf(intab,",") ;
- }
- fclose(in) ;
-}
+++ /dev/null
-Makefile
-em_pc.c
+++ /dev/null
-d=../../..
-h=$d/h
-
-PC_PATH=$d/lib/em_pc
-
-em_pc: em_pc.c $h/local.h $h/em_path.h
- cc -n -o em_pc -O -I$h em_pc.c
-
-cmp: em_pc
- cmp em_pc $(PC_PATH)
-
-install: em_pc
- cp em_pc $(PC_PATH)
-
-lint:
- lint -hpxc -I$h em_pc.c
-
-clean:
- rm -f *.o *.old em_pc
-
-opr:
- make pr ^ opr
-
-pr:
- pr -n em_pc.c
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "../../h/em_path.h"
-#include "list.h"
-#include "trans.h"
-#include "grows.h"
-#include "dmach.h"
-#include "data.h"
-#include <stdio.h>
-
-/************************************************************************/
-/* */
-/* Read machine definitions and transformations */
-/* */
-/************************************************************************/
-
-#define COMMENT '#'
-
-#define VAR "var"
-#define PASS "name"
-#define IN "from"
-#define OUT "to"
-#define PROG "program"
-#define MAPF "mapflag"
-#define ARGS "args"
-#define PROP "prop"
-#define RUNT "rts"
-#define NEEDT "need"
-#define END "end"
-
-extern growstring scanb();
-extern growstring scanvars();
-
-int getline() ;
-int getinchar() ;
-static char *ty_name ;
-static char *bol ;
-
-
-static char *inname ;
-
-setlist(name) char *name ; {
- /* Name is sought in the internal tables,
- if not present, the a file of that name is sought
- in first the current and then the EM Lib directory
- */
-
- inname=name ;
- open_in(name) ;
- while ( getline() ) {
- if ( strcmp(VAR,ty_name)==0 ) {
- doassign(bol,(char *)0,0) ;
- } else
- if ( strcmp(PASS,ty_name)==0 ) {
- intrf() ;
- } else
- error("unknown keyword %s",ty_name) ;
- }
- close_in();
-#ifdef DEBUG
- if ( debug>=3 ) vprint("End %s\n",name) ;
-#endif
-}
-
-intrf() {
- register trf *new ;
- register char *ptr ;
- growstring bline, vline ;
- int twice ;
-
- new= (trf *)getcore(sizeof *new) ;
- new->t_name= keeps(bol) ;
- for (;;) {
- if ( !getline() ) {
- fuerror("unexpected EOF on %s",inname) ;
- }
- twice= NO ;
- if ( strcmp(ty_name,IN)==0 ) {
- if ( new->t_in ) twice=YES ;
- new->t_in= keeps(bol);
- } else
- if ( strcmp(ty_name,OUT)==0 ) {
- if ( new->t_out ) twice=YES ;
- new->t_out= keeps(bol);
- } else
- if ( strcmp(ty_name,PROG)==0 ) {
- if ( new->t_prog ) twice=YES ;
- bline= scanb(bol); /* Scan for \ */
- vline= scanvars(gr_start(bline)); /* Scan for {} */
- gr_throw(&bline);
- new->t_prog= gr_final(&vline);
- clr_noscan(new->t_prog);
- } else
- if ( strcmp(ty_name,MAPF)==0 ) {
- /* First read the mapflags line
- and scan for backslashes */
- bline= scanb(bol) ;
- l_add(&new->t_mapf,gr_final(&bline)) ;
- } else
- if ( strcmp(ty_name,ARGS)==0 ) {
- if ( new->t_argd ) twice=YES ;
- bline= scanb(bol) ;
- new->t_argd= keeps(gr_start(bline)) ;
- gr_throw(&bline) ;
- } else
- if ( strcmp(ty_name,PROP)==0 ) {
- for ( ptr=bol ; *ptr ; ptr++ ) {
- switch( *ptr ) {
- case C_IN: new->t_stdin= YES ; break ;
- case C_OUT: new->t_stdout= YES ; break ;
- case 'P': new->t_isprep= YES ; break ;
- case 'p': new->t_prep= YES ; break ;
- case 'm': new->t_prep= MAYBE ; break ;
- case 'O': new->t_optim= YES ; break ;
- case 'C': new->t_combine= YES ; break ;
- default :
- error("Unkown option %c in %s for %s",
- *ptr,new->t_name,inname) ;
- break ;
- }
- }
- } else
- if ( strcmp(ty_name,RUNT)==0 ) {
- if ( new->t_rts ) twice=YES ;
- new->t_rts= keeps(bol) ;
- } else
- if ( strcmp(ty_name,NEEDT)==0 ) {
- if ( new->t_needed ) twice=YES ;
- new->t_needed= keeps(bol) ;
- } else
- if ( strcmp(ty_name,END)==0 ) {
- break ;
- } else {
- fuerror("illegal keyword %s %s",ty_name,bol);
- }
- if ( twice ) {
- werror("%s: specified twice for %s",
- ty_name, new->t_name) ;
- }
- }
- if ( ! ( new->t_name && new->t_out && new->t_prog ) ) {
- fuerror("insufficient specification for %s in %s",
- new->t_name,inname) ;
- }
- if ( ! new->t_argd ) new->t_argd="" ;
-#ifdef DEBUG
- if ( debug>=3 ) {
- register list_elem *elem ;
- vprint("%s: from %s to %s '%s'\n",
- new->t_name,new->t_in,new->t_out,new->t_prog) ;
- vprint("\targs: ") ; prns(new->t_argd) ;
- scanlist( l_first(new->t_mapf), elem ) {
- vprint("\t%s\n",l_content(*elem)) ;
- }
- if ( new->t_rts ) vprint("\trts: %s\n",new->t_rts) ;
- if ( new->t_needed ) vprint("\tneeded: %s\n",new->t_needed) ;
- }
-#endif
- l_add(&tr_list,(char *)new) ;
-}
-
-/************************** IO from core or file *******************/
-
-static int incore ;
-static growstring rline ;
-static FILE *infile ;
-static char *inptr ;
-
-open_in(name) register char *name ; {
- register dmach *cmac ;
-
- gr_init(&rline) ;
- for ( cmac= massoc ; cmac->ma_index!= -1 ; cmac++ ) {
- if ( strcmp(name,cmac->ma_name)==0 ) {
- incore=YES ;
- inptr= &intable[cmac->ma_index] ;
- return ;
- }
- }
- /* Not in core */
- incore= NO ;
- gr_cat(&rline,ACK_DIR); gr_cat(&rline,"/") ;
- gr_cat(&rline,name) ;
- infile= fopen(gr_start(rline),"r") ;
- if ( !infile ) {
- infile= fopen(name,"r") ;
- }
- if ( infile==NULL ) {
- fuerror("Cannot find description for %s",name) ;
- }
-}
-
-close_in() {
- if ( !incore ) fclose(infile) ;
- gr_throw(&rline) ;
-}
-
-char *readline() {
- /* Get a line from the input,
- return 0 if at end,
- The line is stored in a volatile buffer,
- a pointer to the line is returned.
- */
- register int nchar ;
- enum { BOL, ESCAPE, SKIPPING, MOL } state = BOL ;
-
- gr_throw(&rline) ;
- for (;;) {
- nchar= getinchar() ;
- if ( nchar==EOF ) {
- if ( state!=BOL ) {
- werror("incomplete line in %s", inname) ;
- }
- return 0 ;
- }
- if ( state==SKIPPING ) {
- if ( nchar=='\n' ) {
- state= MOL ;
- } else {
- continue ;
- }
- }
- if ( state==ESCAPE ) {
- switch( nchar ) {
- case '\n' :
- break ;
- default :
- gr_add(&rline,BSLASH) ;
- case COMMENT :
- case BSLASH :
- gr_add(&rline,nchar) ;
- break ;
- }
- state= MOL ;
- continue ;
- }
- switch ( nchar ) {
- case '\n' : gr_add(&rline,0) ;
- return gr_start(rline) ;
- case COMMENT : state= SKIPPING ;
- break ;
- case BSLASH : state= ESCAPE ;
- break ;
- default : gr_add(&rline,nchar) ;
- state= MOL ;
- }
- }
-}
-
-int getinchar() {
- if ( incore ) {
- if ( *inptr==0 ) return EOF ;
- return *inptr++ ;
- }
- return getc(infile) ;
-}
-
-int getline() {
- register char *c_ptr ;
-
- do {
- if ( (c_ptr=readline())==(char *)0 ) return 0 ;
- ty_name= skipblank(c_ptr) ;
- } while ( *ty_name==0 ) ;
- c_ptr= firstblank(ty_name) ;
- if ( *c_ptr ) {
- *c_ptr++ =0 ;
- c_ptr= skipblank(c_ptr) ;
- }
- bol= c_ptr ;
- return 1 ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "data.h"
-#include <signal.h>
-
-#define ARG_MORE 40 /* The size of args chunks to allocate */
-
-static char **arglist ; /* The first argument */
-static unsigned argcount ; /* The current number of arguments */
-static unsigned argmax; /* The maximum number of arguments so far */
-
-int do_run() {
- fatal("-g flag not implemeted") ;
- /*NOTREACHED*/
- return 0 ;
-}
-
-int runphase(phase) register trf *phase ; {
- register list_elem *elem ;
-
- if ( v_flag || debug ) {
- if ( v_flag==1 && !debug ) {
- vprint("%s",phase->t_name) ;
- if ( !phase->t_combine ) {
- vprint(" %s%s\n",p_basename,
- rindex(in.p_path,SUFCHAR) ) ;
- } else {
- scanlist(l_first(c_arguments), elem) {
- vprint(" %s",l_content(*elem)) ;
- }
- vprint("\n") ;
- }
- } else {
- /* list all args */
- vprint("%s",phase->t_prog) ;
- scanlist(l_first(phase->t_flags), elem) {
- vprint(" %s",l_content(*elem)) ;
- }
- scanlist(l_first(phase->t_args), elem) {
- vprint(" %s",l_content(*elem)) ;
- }
- vprint("\n") ;
- }
- }
- argcount=0 ;
- x_arg(phase->t_name) ;
- scanlist(l_first(phase->t_flags), elem) {
- x_arg(l_content(*elem)) ;
- }
- scanlist(l_first(phase->t_args), elem) {
- x_arg(l_content(*elem)) ;
- }
- x_arg( (char *)0 ) ;
- return run_exec(phase) ;
-}
-
-int run_exec(phase) trf *phase ; {
- int status, child, waitchild ;
-
- do_flush();
- while ( (child=fork())== -1 ) ;
- if ( child ) {
- /* The parent */
- do {
- waitchild= wait(&status) ;
- if ( waitchild== -1 ) {
- fatal("missing child") ;
- }
- } while ( waitchild!=child) ;
- if ( status ) {
- if ( status&0200 && (status&0177)!=SIGQUIT &&
- !t_flag ) unlink("core") ;
- switch ( status&0177 ) {
- case 0 :
- break ;
- case SIGHUP:
- case SIGINT:
- case SIGQUIT:
- case SIGTERM:
- quit(-5) ;
- default:
- error("%s died with signal %d",
- phase->t_prog,status&0177) ;
- }
- /* The assumption is that processes voluntarely
- dying with a non-zero status already produced
- some sort of error message to the outside world.
- */
- n_error++ ;
- return 0 ;
- }
- return 1 ; /* From the parent */
- }
- /* The child */
- if ( phase->t_stdin ) {
- if ( !in.p_path ) {
- fatal("no input file for %s",phase->t_name) ;
- }
- close(0) ;
- if ( open(in.p_path,0)!=0 ) {
- error("cannot open %s",in.p_path) ;
- exit(1) ;
- }
- }
- if ( phase->t_stdout ) {
- if ( !out.p_path ) {
- fatal("no output file for %s",phase->t_name) ;
- }
- close(1) ;
- if ( creat(out.p_path,0666)!=1 ) {
- close(1); dup(2);
- error("cannot open %s",out.p_path) ;
- exit(1) ;
- }
- }
- execv(phase->t_prog,arglist) ;
- if ( phase->t_stdout ) { close(1) ; dup(2) ; }
- error("Cannot execute %s",phase->t_prog) ;
- exit(1) ;
- /*NOTREACHED*/
-}
-
-x_arg(string) char *string ; {
- /* Add one execute argument to the argument vector */
- if ( argcount==argmax ) {
- if ( argmax==0 ) {
- argmax= 2*ARG_MORE ;
- arglist= (char **)getcore(argmax*sizeof (char *)) ;
- } else {
- argmax += ARG_MORE ;
- arglist= (char **)changecore((char *)arglist,
- argmax*sizeof (char *)) ;
- }
- }
- *(arglist+argcount++) = string ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "data.h"
-
-enum f_path setpath() { /* Try to find a transformation path */
-
- start_scan();
- /*
- The end result is the setting of the t_do flags
- in the transformation list.
- The list is scanned for possible transformations
- stopping at stopsuffix or a combine transformation.
- The scan flags are set by this process.
- When a transformation is found, it is compared with
- the last transformation found, if better (or the first)
- the scan bits are copied to the t_do bits, except for
- the combiner which is remembered in a global pointer.
- At the end of all transformations for all files, the combiner
- is called, unless errors occurred.
- */
- try(l_first(tr_list),p_suffix);
- return scan_end();
-}
-
-/******************** data used only while scanning *******************/
-
-static int last_ncount; /* The # of non-optimizing transformations
- in the best path sofar */
-
-static int last_ocount; /* The # of optimizing transformations in the
- best path sofar */
-static int com_err; /* Complain only once about multiple linkers*/
-
-static trf *final; /* The last non-combining transformation */
-
-static int suf_found; /* Was the suffix at least recognized ? */
-
-/******************** The hard work ********************/
-
-start_scan() {
- register list_elem *scan ;
-
- scanlist(l_first(tr_list),scan) {
- t_cont(*scan)->t_do=NO ; t_cont(*scan)->t_scan=NO ;
- t_cont(*scan)->t_keep=NO ;
- }
- final= (trf *)0 ;
- suf_found= 0 ;
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Scan_start\n");
-#endif
- last_ncount= -1 ;
- last_ocount= 0 ;
-}
-
-try(f_scan,suffix) list_elem *f_scan; char *suffix; {
- register list_elem *scan ;
- register trf *trafo ;
- /* Try to find a transformation path starting at f_scan for a
- file with the indicated suffix.
- If the suffix is already reached or the combiner is found
- call scan_found() to OK the scan.
- If a transformation is found it calls itself recursively
- with as starting point the next transformation in the list.
- */
- if ( stopsuffix && *stopsuffix && strcmp(stopsuffix,suffix)==0 ) {
- scan_found();
- return ;
- }
- scanlist(f_scan, scan) {
- trafo= t_cont(*scan) ;
- if ( satisfy(trafo,suffix) ) {
- /* Found a transformation */
- suf_found= 1;
-#ifdef DEBUG
- if ( debug>=4 ) {
- vprint("Found %s for %s: result %s\n",
- trafo->t_name,suffix,trafo->t_out);
- }
-#endif
- trafo->t_scan=YES ;
- if ( trafo->t_prep ) {
- if ( !cpp_trafo ) {
- find_cpp() ;
- }
- if ( stopsuffix &&
- strcmp(stopsuffix,
- cpp_trafo->t_out)==0 )
- {
- scan_found() ;
- return ;
- }
- }
- if ( trafo->t_combine ) {
- if ( stopsuffix ) {
- trafo->t_scan=NO;
- if ( *stopsuffix ) return ;
- } else {
- if( combiner &&
- combiner!=trafo && !com_err ){
- com_err++ ;
-werror("Multiple linkers present %s and %s",
- trafo->t_name,combiner->t_name) ;
- } else {
- combiner=trafo;
- }
- }
- scan_found() ;
- } else {
- try(l_next(*scan),trafo->t_out);
- }
- trafo->t_scan= NO ;
- }
- }
-}
-
-scan_found() {
- register list_elem *scan;
- int ncount, ocount ;
- register trf *keepit ;
-
- keepit= (trf *)0 ;
- suf_found= 1;
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Scan found\n") ;
-#endif
- /* Gather data used in comparison */
- ncount=0; ocount=0;
- scanlist(l_first(tr_list),scan) {
- if (t_cont(*scan)->t_scan) {
-#ifdef DEBUG
- if ( debug>=4 ) vprint("%s-",t_cont(*scan)->t_name) ;
-#endif
- if( t_cont(*scan)->t_optim ) ocount++ ;else ncount++ ;
- if ( !(t_cont(*scan)->t_combine) ) {
- keepit= t_cont(*scan) ;
- }
- }
- }
-#ifdef DEBUG
- if ( debug>=4 ) vprint("\n");
-#endif
- /* Is this transformation better then any found yet ? */
-#ifdef DEBUG
- if ( debug>=3 ) {
- vprint("old n:%d, o:%d - new n:%d, o:%d\n",
- last_ncount,last_ocount,ncount,ocount) ;
- }
-#endif
- if ( last_ncount== -1 || /* None found yet */
- last_ncount>ncount || /* Shorter nec. path */
- (last_ncount==ncount && /* Same nec. path, optimize?*/
- (Optflag? last_ocount<ocount : last_ocount>ocount ) ) ) {
- /* Yes it is */
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Better\n");
-#endif
- scanlist(l_first(tr_list),scan) {
- t_cont(*scan)->t_do=t_cont(*scan)->t_scan;
- }
- last_ncount=ncount; last_ocount=ocount;
- if ( keepit ) final=keepit ;
- }
-}
-
-int satisfy(trafo,suffix) register trf *trafo; char *suffix ; {
- register char *f_char, *l_char ;
- /* Check whether this transformation is present for
- the current machine and the parameter suffix is among
- the input suffices. If so, return 1. 0 otherwise
- */
- if ( trafo->t_isprep ) return 0 ;
- l_char=trafo->t_in ;
- while ( l_char ) {
- f_char= l_char ;
- if ( *f_char!=SUFCHAR || ! *(f_char+1) ) {
- fuerror("Illegal input suffix entry for %s",
- trafo->t_name) ;
- }
- l_char=index(f_char+1,SUFCHAR);
- if ( l_char ? strncmp(f_char,suffix,l_char-f_char)==0 :
- strcmp(f_char,suffix)==0 ) {
- return 1 ;
- }
- }
- return 0 ;
-}
-
-enum f_path scan_end() { /* Finalization */
- /* Return value indicating whether a transformation was found */
- /* Set the flags for the transformation up to, but not including,
- the combiner
- */
-
-#ifdef DEBUG
- if ( debug>=3 ) vprint("End_scan\n");
-#endif
- if ( last_ncount== -1 ) return suf_found ? F_NOPATH : F_NOMATCH ;
-#ifdef DEBUG
- if ( debug>=2 ) vprint("Transformation found\n");
-#endif
- if ( cpp_trafo && stopsuffix &&
- strcmp(stopsuffix,cpp_trafo->t_out)==0 ) {
- final= cpp_trafo ;
- }
- /* There might not be a final when the file can be eaten
- by the combiner
- */
- if ( final ) final->t_keep=YES ;
- if ( combiner ) {
- if ( !combiner->t_do ) error("Combiner YES/NO");
- combiner->t_do=NO ;
- }
- return F_OK ;
-}
-
-find_cpp() {
- register list_elem *elem ;
- scanlist( l_first(tr_list), elem ) {
- if ( t_cont(*elem)->t_isprep ) {
- if ( cpp_trafo ) fuerror("Multiple cpp's present") ;
- cpp_trafo= t_cont(*elem) ;
- }
- }
- if ( !cpp_trafo ) fuerror("No cpp present") ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-
-/* The processing of string valued variables,
- this is an almost self contained module.
-
- Five externally visible routines:
-
- setsvar(name,result)
- Associate the name with the result.
-
- name a string pointer
- result a string pointer
-
- setpvar(name,routine)
- Associate the name with the routine.
-
- name a string pointer
- routine a routine id
-
- The parameters name and result are supposed to be pointing to
- non-volatile string storage used only for this call.
-
- char *getvar(name)
- returns the pointer to a string associated with name,
- the pointer is produced by returning result or the
- value returned by calling the routine.
-
- name a string pointer
-
- Other routines called
-
- fatal(args*) When something goes wrong
- getcore(size) Core allocation
-
-*/
-
-extern char *getcore();
-extern fatal();
-
-struct vars {
- char *v_name;
- enum { routine, string } v_type;
-
- union {
- char *v_string;
- char *(*v_routine)();
- } v_value ;
- struct vars *v_next ;
-};
-
-static struct vars *v_first ;
-
-static struct vars *newvar(name) char *name; {
- register struct vars *new ;
-
- for ( new=v_first ; new ; new= new->v_next ) {
- if ( strcmp(name,new->v_name)==0 ) {
- throws(name) ;
- if ( new->v_type== string ) {
- throws(new->v_value.v_string) ;
- }
- return new ;
- }
- }
- new= (struct vars *)getcore( (unsigned)sizeof (struct vars));
- new->v_name= name ;
- new->v_next= v_first ;
- v_first= new ;
- return new ;
-}
-
-setsvar(name,str) char *name, *str ; {
- register struct vars *new ;
-
- new= newvar(name);
-#ifdef DEBUG
- if ( debug>=2 ) vprint("%s=%s\n", name, str) ;
-#endif
- new->v_type= string;
- new->v_value.v_string= str;
-}
-
-setpvar(name,rout) char *name, *(*rout)() ; {
- register struct vars *new ;
-
- new= newvar(name);
-#ifdef DEBUG
- if ( debug>=2 ) vprint("%s= (*%o)()\n",name,rout) ;
-#endif
- new->v_type= routine;
- new->v_value.v_routine= rout;
-}
-
-char *getvar(name) char *name ; {
- register struct vars *scan ;
-
- for ( scan=v_first ; scan ; scan= scan->v_next ) {
- if ( strcmp(name,scan->v_name)==0 ) {
- switch ( scan->v_type ) {
- case string:
- return scan->v_value.v_string ;
- case routine:
- return (*scan->v_value.v_routine)() ;
- }
- }
- }
- return (char *)0 ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "grows.h"
-#include "data.h"
-
-/****************************************************************************/
-/* Routines for transforming from one file type to another */
-/****************************************************************************/
-
-static growstring head ;
-static int touch_head= NO ;
-static growstring tail ;
-static int touch_tail= NO ;
-
-char *headvar(),*tailvar() ;
-
-int transform(phase) register trf *phase ; {
- int ok ;
-
- if ( !setfiles(phase) ) return 0 ;
- if ( !phase->t_visited ) {
- /* The flags are set up once.
- At the first time the phase is used.
- The program name and flags may already be touched
- by vieuwargs.
- */
- phase->t_visited=YES ;
- if ( !rts && phase->t_rts ) rts= phase->t_rts ;
- if ( phase->t_needed ) {
- add_head(phase->t_needed) ;
- add_tail(phase->t_needed) ;
- }
- }
- getcallargs(phase) ;
- ok= runphase(phase) ;
- if ( !ok ) rmtemps() ;
- /* Free the space occupied by the arguments,
- except for the combiner, since we are bound to exit soon
- and do not foresee further need of memory space */
- if ( !phase->t_combine ) discardargs(phase) ;
- disc_files() ;
- return ok ;
-}
-
-int do_combine() {
- setsvar(keeps(RTS), keeps(rts? rts : "") ) ;
- if ( !outfile ) outfile= combiner->t_out ;
- getmapflags(combiner);
- return transform(combiner) ;
-}
-
-getmapflags(phase) register trf *phase ; {
- register list_elem *elem ;
- int scanned ;
- register char *ptr ;
-
- scanlist(l_first(flags),elem) {
- scanned= *(l_content(*elem))&NO_SCAN ;
- *(l_content(*elem)) &= ~NO_SCAN ;
- if ( mapflag(&(phase->t_mapf),l_content(*elem)) ) {
- scanned=NO_SCAN ;
-#ifdef DEBUG
- if ( debug >=4 ) {
- vprint("phase %s, added mapflag for %s\n",
- phase->t_name,
- l_content(*elem) ) ;
- }
-#endif
- }
- *(l_content(*elem)) |= scanned ;
- }
- if ( phase->t_combine ) {
- scanlist(l_first(c_arguments),elem) {
- if ( mapflag(&(phase->t_mapf),l_content(*elem)) ) {
- throws(l_content(*elem)) ;
- ptr= keeps(getvar(LIBVAR)) ;
- clr_noscan(ptr) ;
- l_content(*elem)= ptr ;
- }
- }
- scanlist(l_first(flags),elem) {
- /* Get the flags remaining for the loader,
- That is: all the flags neither eaten by ack nor
- one of the subprograms called so-far.
- The last fact is indicated by the NO_SCAN bit
- in the first character of the flag.
- */
- if ( !( *(l_content(*elem))&NO_SCAN ) ) {
- l_add(&(phase->t_flags),l_content(*elem)) ;
- }
- }
- }
-}
-
-
-do_Rflag(argp) char *argp ; {
- l_add(&R_list,argp) ;
-}
-
-char *needvar() {
- static growstring needed ;
- static int been_here = NO ;
-
- if ( !been_here ) {
- gr_init(&needed) ;
- been_here=YES ;
- gr_cat(&needed,headvar()) ;
- gr_cat(&needed,tailvar()) ;
- }
- return gr_start(needed) ;
-}
-
-char *headvar() {
- if ( !touch_head) return "" ;
- return gr_start(head) ;
-}
-
-add_head(str) char *str; {
- if ( !touch_head) {
- gr_init(&head) ;
- touch_head=YES ;
- }
- gr_cat(&head,str) ;
-}
-
-char *tailvar() {
- if ( !touch_tail ) return "" ;
- return gr_start(tail) ;
-}
-
-add_tail(str) char *str ; {
- if ( !touch_tail ) {
- gr_init(&tail) ;
- touch_tail=YES ;
- }
- gr_cat(&tail,str) ;
-}
-
-
-transini() {
- register list_elem *elem ;
- register trf *phase ;
-
- scanlist(l_first(R_list), elem) {
- set_Rflag(l_content(*elem)) ;
- }
- l_clear(&R_list) ;
- scanlist(l_first(tr_list), elem) {
- phase = t_cont(*elem) ;
- if ( !phase->t_combine ) getmapflags(phase);
- }
- setpvar(keeps(NEEDS),needvar) ;
- setpvar(keeps(HEAD),headvar) ;
- setpvar(keeps(TAIL),tailvar) ;
-}
-
-set_Rflag(argp) register char *argp ; {
- int seen ;
- register char *eos ;
- register list_elem *prog ;
- register int length ;
- char *eq ;
-
- eos= index(&argp[2],'-');
- eq= index(&argp[2],EQUAL) ;
- if ( !eos ) {
- eos= eq ;
- } else {
- if ( eq && eq<eos ) eos= eq ;
- }
- if ( !eos ) fuerror("Incorrect use of -R flag") ;
- length= eos - &argp[2] ;
- seen=NO ;
- scanlist(l_first(tr_list), prog) {
- if ( strncmp(t_cont(*prog)->t_name, &argp[2], length )==0 ) {
- if ( *eos=='-' ) {
- l_add(&(t_cont(*prog)->t_flags),eos) ;
- } else {
- t_cont(*prog)->t_prog= eos+1 ;
- }
- seen=YES ;
- }
- }
- if ( !seen ) error("Cannot find program for %s",argp) ;
- return ;
-}
-
-/**************************************************************************/
-/* */
-/* The creation of arguments for exec for a transformation */
-/* */
-/**************************************************************************/
-
-growstring scanb(line) char *line ; {
- /* Scan a line for backslashes, setting the NO_SCAN bit in characters
- preceded by a backslash.
- */
- register char *in_c ;
- register int token ;
- growstring result ;
- enum { TEXT, ESCAPED } state = TEXT ;
-
- gr_init(&result) ;
- for ( in_c= line ; *in_c ; in_c++ ) {
- token= *in_c&0377 ;
- switch( state ) {
- case TEXT :
- if ( token==BSLASH ) {
- state= ESCAPED ;
- } else {
- gr_add(&result,token) ;
- }
- break ;
- case ESCAPED :
- gr_add(&result,token|NO_SCAN) ;
- state=TEXT ;
- break ;
- }
- }
- gr_add(&result,0) ;
- if ( state!=TEXT ) werror("flag line ends with %c",BSLASH) ;
- return result ;
-}
-
-growstring scanvars(line) char *line ; {
- /* Scan a line variable replacements started by S_VAR.
- Two sequences exist: S_VAR name E_VAR, S_VAR name A_VAR text E_VAR.
- neither name nor text may contain further replacements.
- In the first form an error message is issued if the name is not
- present in the variables, the second form produces text
- in that case.
- The sequence S_VAR S_VAR is transformed into S_VAR.
- This to allow later recognition in mapflags, where B_SLASH
- would be preventing any recognition.
- */
- register char *in_c ;
- register int token ;
- growstring result ;
- growstring name ;
- register char *tr ;
- enum { TEXT, FIRST, NAME, SKIP, COPY } state = TEXT ;
-
- gr_init(&result) ; gr_init(&name) ;
- for ( in_c= line ; *in_c ; in_c++ ) {
- token= *in_c&0377 ;
- switch( state ) {
- case TEXT :
- if ( token==S_VAR ) {
- state= FIRST ;
- } else {
- gr_add(&result,token) ;
- }
- break ;
- case FIRST :
- switch ( token ) {
- case S_VAR :
- state= TEXT ;
- gr_add(&result,token) ;
- break ;
- case A_VAR :
- case C_VAR :
- fatal("empty string variable name") ;
- default :
- state=NAME ;
- gr_add(&name,token) ;
- break ;
- }
- break ;
- case NAME:
- switch ( token ) {
- case A_VAR :
- gr_add(&name,0) ;
- if ( tr=getvar(gr_start(name)) ) {
- while ( *tr ) {
- gr_add(&result,*tr++) ;
- }
- state=SKIP ;
- } else {
- state=COPY ;
- }
- gr_throw(&name) ;
- break ;
- case C_VAR :
- gr_add(&name,0) ;
- if ( tr=getvar(gr_start(name)) ) {
- while ( *tr ) {
- gr_add(&result,*tr++);
- }
- } else {
- werror("No definition for %s",
- gr_start(name)) ;
- }
- state=TEXT ;
- gr_throw(&name) ;
- break ;
- default:
- gr_add(&name,token) ;
- break ;
- }
- break ;
- case SKIP :
- if ( token==C_VAR ) state= TEXT ;
- break ;
- case COPY :
- if ( token==C_VAR ) state= TEXT ; else {
- gr_add(&result,token) ;
- }
- break ;
- }
- }
- gr_add(&result,0) ;
- if ( state!=TEXT ) {
- werror("flag line misses %c",C_VAR) ;
- gr_throw(&name) ;
- }
- return result ;
-}
-
-growstring scanexpr(line) char *line ; {
- /* Scan a line for conditional or flag expressions,
- dependent on the type. The format is
- S_EXPR suflist M_EXPR suflist T_EXPR tail C_EXPR
- the head and tail are passed to treat, together with the
- growstring for futher treatment.
- Nesting is not allowed.
- */
- register char *in_c ;
- char *heads ;
- register int token ;
- growstring sufs, tailval ;
- growstring result ;
- static list_head fsuff, lsuff ;
- enum { TEXT, FDOT, FSUF, LDOT, LSUF, FTAIL } state = TEXT ;
-
- gr_init(&result) ; gr_init(&sufs) ; gr_init(&tailval) ;
- for ( in_c= line ; *in_c ; in_c++ ) {
- token= *in_c&0377 ;
- switch( state ) {
- case TEXT :
- if ( token==S_EXPR ) {
- state= FDOT ;
- heads=in_c ;
- } else gr_add(&result,token) ;
- break ;
- case FDOT :
- if ( token==M_EXPR ) {
- state=LDOT ;
- break ;
- }
- token &= ~NO_SCAN ;
- if ( token!=SUFCHAR ) {
- error("Missing %c in expression",SUFCHAR) ;
- }
- gr_add(&sufs,token) ; state=FSUF ;
- break ;
- case FSUF :
- if ( token==M_EXPR || (token&~NO_SCAN)==SUFCHAR) {
- gr_add(&sufs,0) ;
- l_add(&fsuff,gr_final(&sufs)) ;
- }
- if ( token==M_EXPR ) {
- state=LDOT ;
- } else gr_add(&sufs,token&~NO_SCAN) ;
- break ;
- case LDOT :
- if ( token==T_EXPR ) {
- state=FTAIL ;
- break ;
- }
- token &= ~NO_SCAN ;
- if ( token!=SUFCHAR ) {
- error("Missing %c in expression",SUFCHAR) ;
- }
- gr_add(&sufs,token) ; state=LSUF ;
- break ;
- case LSUF :
- if ( token==T_EXPR || (token&~NO_SCAN)==SUFCHAR) {
- gr_add(&sufs,0) ;
- l_add(&lsuff,gr_final(&sufs)) ;
- }
- if ( token==T_EXPR ) {
- state=FTAIL ;
- } else gr_add(&sufs,token&~NO_SCAN) ;
- break ;
- case FTAIL :
- if ( token==C_EXPR ) {
- /* Found one !! */
- gr_add(&tailval,0) ;
- condit(&result,&fsuff,&lsuff,gr_start(tailval)) ;
- l_throw(&fsuff) ; l_throw(&lsuff) ;
- gr_throw(&tailval) ;
- state=TEXT ;
- } else gr_add(&tailval,token) ;
- break ;
- }
- }
- gr_add(&result,0) ;
- if ( state!=TEXT ) {
- l_throw(&fsuff) ; l_throw(&lsuff) ; gr_throw(&tailval) ;
- werror("flag line has unclosed expression starting with %6s",
- heads) ;
- }
- return result ;
-}
-
-condit(line,fsuff,lsuff,tailval) growstring *line ;
- list_head *fsuff, *lsuff;
- char *tailval ;
-{
- register list_elem *first ;
- register list_elem *last ;
-
-#ifdef DEBUG
- if ( debug>=4 ) vprint("Conditional for %s, ",tailval) ;
-#endif
- scanlist( l_first(*fsuff), first ) {
- scanlist( l_first(*lsuff), last ) {
- if ( strcmp(l_content(*first),l_content(*last))==0 ) {
- /* Found */
-#ifdef DEBUG
- if ( debug>=4 ) vprint(" matched\n") ;
-#endif
- while ( *tailval) gr_add(line,*tailval++ ) ;
- return ;
- }
- }
- }
-#ifdef DEBUG
- if ( debug>=4) vprint(" non-matched\n") ;
-#endif
-}
-
-int mapflag(maplist,cflag) list_head *maplist ; char *cflag ; {
- /* Expand a flag expression */
- /* The flag "cflag" is checked for each of the mapflags.
- A mapflag entry has the form
- -text NAME=replacement or -text*text NAME=replacement
- The star matches anything as in the shell.
- If the entry matches the assignment will take place
- This replacement is subjected to argument matching only.
- When a match took place the replacement is returned
- when not, (char *)0.
- The replacement sits in stable storage.
- */
- register list_elem *elem ;
-
- scanlist(l_first(*maplist),elem) {
- if ( mapexpand(l_content(*elem),cflag) ) {
- return 1 ;
- }
- }
- return 0 ;
-}
-
-int mapexpand(mapentry,cflag)
- char *mapentry, *cflag ;
-{
- register char *star ;
- register char *ptr ;
- register char *space ;
- int length ;
-
- star=index(mapentry,STAR) ;
- space=firstblank(mapentry) ;
- if ( star >space ) star= (char *)0 ;
- if ( star ) {
- length= space-star-1 ;
- if ( strncmp(mapentry,cflag,star-mapentry) ||
- strncmp(star+1,cflag+strlen(cflag)-length,length) ) {
- return 0 ;
- }
- /* Match */
- /* Now set star to the first char of the star
- replacement and length to its length
- */
- length=strlen(cflag)-(star-mapentry)-length ;
- if ( length<0 ) return 0 ;
- star=cflag+(star-mapentry) ;
-#ifdef DEBUG
- if ( debug>=6 ) {
- vprint("Starmatch (%s,%s) %.*s\n",
- mapentry,cflag,length,star) ;
- }
-#endif
- } else {
- if ( strncmp(mapentry,cflag,space-mapentry)!=0 ||
- cflag[space-mapentry] ) {
- return 0 ;
- }
- }
- ptr= skipblank(space) ;
- if ( *ptr==0 ) return 1 ;
- doassign(ptr,star,length) ;
- return 1 ;
-}
-
-doassign(line,star,length) char *line, *star ; {
- growstring varval, name, temp ;
- register char *ptr ;
-
- gr_init(&varval) ;
- gr_init(&name) ;
- ptr= line ;
- for ( ; *ptr && *ptr!=SPACE && *ptr!=TAB && *ptr!=EQUAL ; ptr++ ) {
- gr_add(&name,*ptr) ;
- }
- ptr= index(ptr,EQUAL) ;
- if ( !ptr ) {
- error("Missing %c in assignment %s",EQUAL,line);
- return ;
- }
- temp= scanvars(ptr+1) ;
- for ( ptr=gr_start(temp); *ptr; ptr++ ) switch ( *ptr ) {
- case STAR :
- if ( star ) {
- while ( length-- ) gr_add(&varval,*star++|NO_SCAN) ;
- break ;
- }
- default :
- gr_add(&varval,*ptr) ;
- break ;
- }
- gr_throw(&temp) ;
- setsvar(gr_final(&name),gr_final(&varval)) ;
-}
-
-#define ISBLANK(c) ( (c)==SPACE || (c)==TAB )
-
-unravel(line,action) char *line ; int (*action)() ; {
- /* Unravel the line, get arguments a la shell */
- /* each argument is handled to action */
- /* The input string is left intact */
- register char *in_c ;
- register int token ;
- enum { BLANK, ARG } state = BLANK ;
- growstring argum ;
-
- in_c=line ;
- for (;;) {
- token= *in_c&0377 ;
- switch ( state ) {
- case BLANK :
- if ( token==0 ) break ;
- if ( !ISBLANK(token) ) {
- state= ARG ;
- gr_init(&argum) ;
- gr_add(&argum,token&~NO_SCAN) ;
- }
- break ;
- case ARG :
- if ( ISBLANK(token) || token==0 ) {
- gr_add(&argum,0) ;
- (*action)(gr_start(argum)) ;
- gr_throw(&argum) ;
- state=BLANK ;
- } else {
- gr_add(&argum,token&~NO_SCAN) ;
- }
- break ;
- }
- if ( token == 0 ) break ;
- in_c++ ;
- }
-}
-
-char *c_rep(string,place,rep) char *string, *place, *rep ; {
- /* Produce a string in stable storage produced from 'string'
- with the character at place replaced by rep
- */
- growstring name ;
- register char *nc ;
- register char *xc ;
-
- gr_init(&name) ;
- for ( nc=string ; *nc && nc<place ; nc++ ) {
- gr_add(&name,*nc) ;
- }
-#ifdef DEBUG
- if ( *nc==0 ) fatal("Place is not in string") ;
-#endif
- for ( xc=rep ; *xc ; xc++ ) gr_add(&name,*xc|NO_SCAN) ;
- gr_add(&name,0) ;
- gr_cat(&name,nc+1) ;
- return gr_final(&name) ;
-}
-
-static list_head *curargs ;
-
-addargs(string) char *string ; {
- register char *temp, *repc ;
- register list_elem *elem ;
-
- repc=index(string,C_IN) ;
- if ( repc ) {
- /* INPUT FILE TOKEN seen, replace it and scan further */
- if ( repc==string && string[1]==0 ) {
- if ( in.p_path ) { /* All but combiner */
- l_add(curargs,keeps(in.p_path)) ;
- } else {
- scanlist( l_first(c_arguments), elem ) {
- l_add(curargs,l_content(*elem)) ;
- }
- }
- return ;
- }
- if ( in.p_path ) { /* Not for the combiner */
- temp=c_rep(string,repc,in.p_path) ;
- addargs(temp) ;
- throws(temp) ;
- } else { /* For the combiner */
- scanlist( l_first(c_arguments), elem ) {
- temp=c_rep(string,repc,l_content(*elem)) ;
- addargs(temp) ;
- throws(temp) ;
- }
- }
- return ;
- }
- repc=index(string,C_OUT) ;
- if ( repc ) {
- /* replace the outfile token as with the infile token */
-#ifdef DEBUG
- if ( !out.p_path ) fatal("missing output filename") ;
-#endif
- temp=c_rep(string,repc,out.p_path) ;
- addargs(temp) ;
- throws(temp) ;
- return ;
- }
- temp= keeps(string) ;
- clr_noscan(temp) ;
- l_add(curargs,temp) ;
-}
-
-getcallargs(phase) register trf *phase ; {
- growstring arg1, arg2 ;
-
- arg1= scanvars(phase->t_argd) ;
-#ifdef DEBUG
- if ( debug>=3 ) { vprint("\tvars: ") ; prns(gr_start(arg1)) ; }
-#endif
- arg2= scanexpr(gr_start(arg1)) ;
-#ifdef DEBUG
- if ( debug>=3 ) { vprint("\texpr: ") ; prns(gr_start(arg2)) ; }
-#endif
- gr_throw(&arg1) ;
- curargs= &phase->t_args ;
- unravel( gr_start(arg2), addargs ) ;
- gr_throw(&arg2) ;
-}
-
-discardargs(phase) register trf *phase ; {
- l_throw(&phase->t_args) ;
-}
+++ /dev/null
-/* This structure is the center of all actions */
-/* It contains the description of all phases,
- the suffices they consume and produce and various properties */
-
-typedef struct transform trf;
-
-struct transform {
- char *t_in ; /* Suffices in '.o.k' */
- char *t_out ; /* Result '.suffix' or 'name' */
- char *t_name ; /* The name of this transformation */
- list_head t_mapf ; /* Mapflags argument, uses varrep */
- char *t_argd ; /* Argument descriptor, uses varrep */
- char *t_needed ; /* Suffix indicating the libraries needed */
- char *t_rts ; /* Suffix indicating the major language used*/
- int t_stdin:1 ; /* The input is taken on stdin */
- int t_stdout:1 ; /* The output comes on stdout */
- int t_combine:1 ; /* Transform several files to one result */
- int t_visited:1 ; /* NO before setup, YES after */
- int t_prep:2 ; /* Needs preprocessor YES/NO/MAYBE */
- int t_optim:1 ; /* Is optimizer */
- int t_isprep:1 ; /* Is preprocessor */
- int t_keep:1 ; /* Keep the output file */
- char *t_prog ; /* Pathname for load file */
- list_head t_flags ; /* List of flags */
- list_head t_args ; /* List of arguments */
- int t_scan:1 ; /* Used while finding path's */
- int t_do:1 ; /* Is in path to execute */
-} ;
-
-#define t_cont(elem) ((trf *)l_content(elem))
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/**********************************************************************/
-/* */
-/* Several utility routines used throughout ack */
-/* error handling, string handling and such. */
-/* */
-/**********************************************************************/
-
-#include "ack.h"
-#include <ctype.h>
-#include <stdio.h>
-
-extern char *progname ;
-extern int w_flag ;
-extern int n_error;
-
-extern char *calloc();
-extern char *realloc();
-
-#ifdef DEBUG
-# define STDOUT stdout
-#else
-# define STDOUT stderr
-#endif
-
-char *basename(string) char *string ; {
- static char retval[20] ;
- char *last_dot, *last_start ;
- register char *store;
- register char *fetch ;
- register int ctoken ;
-
- last_dot= (char *)0 ;
- last_start= string ;
- for ( fetch=string ; ; fetch++ ) {
- switch ( ctoken= *fetch&0377 ) {
- case SUFCHAR : last_dot=fetch ; break ;
- case '/' : last_start=fetch+1 ; break ;
- case 0 : goto out ;
- }
- if ( !isascii(ctoken) || !isprint(ctoken) ) {
- werror("non-ascii characters in argument %s",string) ;
- }
- }
-out:
- if ( ! *last_start ) fuerror("empty filename \"%s\"",string) ;
- for ( fetch= last_start, store=retval ;
- *fetch && fetch!=last_dot && store< &retval[sizeof retval-1] ;
- fetch++, store++ ) {
- *store= *fetch ;
- }
- *store= 0 ;
- return retval ;
-}
-
-clr_noscan(str) char *str ; {
- register char *ptr ;
- for ( ptr=str ; *ptr ; ptr++ ) {
- *ptr&= ~NO_SCAN ;
- }
-}
-
-char *skipblank(str) char *str ; {
- register char *ptr ;
-
- for ( ptr=str ; *ptr==SPACE || *ptr==TAB ; ptr++ ) ;
- return ptr ;
-}
-
-char *firstblank(str) char *str ; {
- register char *ptr ;
-
- for ( ptr=str ; *ptr && *ptr!=SPACE && *ptr!=TAB ; ptr++ ) ;
- return ptr ;
-}
-
-/* VARARGS1 */
-fatal(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Fatal internal error */
- fprintf(STDOUT,"%s: fatal internal error, ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
- quit(-2) ;
-}
-
-
-/* VARARGS1 */
-vprint(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Diagnostic print, no auto NL */
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
-}
-
-#ifdef DEBUG
-prns(s) register char *s ; {
- for ( ; *s ; s++ ) {
- putc((*s&0377)&~NO_SCAN,STDOUT) ;
- }
- putc('\n',STDOUT) ;
-}
-#endif
-
-/* VARARGS1 */
-fuerror(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Fatal user error */
- fprintf(STDOUT,"%s: ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
- quit(-1) ;
-}
-
-/* VARARGS1 */
-werror(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Warning user error, w_flag */
- if ( w_flag ) return ;
- fprintf(STDOUT,"%s: warning, ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
-}
-
-/* VARARGS1 */
-error(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* User error, it is the callers responsibility to quit */
- fprintf(STDOUT,"%s: ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
- n_error++ ;
-}
-
-do_flush() {
- fflush(stdout) ;
- fflush(stderr) ;
-}
-
-noodstop() {
- quit(-3) ;
-}
-
-quit(code) {
- rmtemps();
- exit(code);
-}
-/******
- char *keeps(string)
- Keep the string in stable storage.
- throws(string)
- Remove the string stored by keep from stable storage.
-***********/
-
-char *keeps(str) char *str ; {
- register char *result ;
- result= getcore( (unsigned)(strlen(str)+1) ) ;
- if ( !result ) fatal("Out of core") ;
- return strcpy(result,str) ;
-}
-
-throws(str) char *str ; {
- freecore(str) ;
-}
-
-char *getcore(size) unsigned size ; {
- register char *retptr ;
-
- retptr= calloc(1,size) ;
- if ( !retptr ) fatal("Out of memory") ;
- return retptr ;
-}
-
-char *changecore(ptr,size) char *ptr ; unsigned size ; {
- register char *retptr ;
-
- retptr= realloc(ptr,size) ;
- if ( !retptr ) fatal("Out of memory") ;
- return retptr ;
-}
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../h
-CFLAGS=$(PREFLAGS)
-LDFLAGS=-i
-LINTOPTS=-hbxac $(PREFLAGS)
-LIBS=../../lib/em_data.a
-# LEXLIB is system dependent, try -ll or -lln first
-LEXLIB=-lln
-
-cgg: bootgram.o
- cc $(LDFLAGS) bootgram.o $(LIBS) $(LEXLIB) -o cgg
-
-install: cgg
- cp cgg ../../lib/cgg
-
-cmp: cgg
- cmp cgg ../../lib/cgg
-
-lint: bootgram.c
- lint $(LINTOPTS) bootgram.c
-clean:
- rm -f bootgram.o bootgram.c bootlex.c cgg
-bootgram.o: bootlex.c
-bootgram.o: ../../h/cg_pattern.h
+++ /dev/null
-%{
-
-#ifndef NORCSID
-static char rcsid[]="$Header$";
-#endif
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#ifdef vax | vax2 | vax4
-#define BIG
-#endif
-
-#ifdef BIG
-#define BORS(x,y) x
-#else
-#define BORS(x,y) y
-#endif
-/* Tunable constants */
-
-#define MAXALLREG 5 /* Maximum number of allocates per rule */
-#define MAXREGS BORS(36,32) /* Total number of registers */
-#define MAXREGVARS 8 /* Maximum regvars per type */
-#define MAXPROPS 16 /* Total number of register properties */
-#define MAXTOKENS BORS(75,32) /* Different kind of tokens */
-#define MAXSETS BORS(100,80) /* Number of tokenexpressions definable */
-#define MAXEMPATLEN 25 /* Maximum length of EM-pattern/replacement */
-#define TOKENSIZE 5 /* Maximum number of fields in token struct */
-#define MAXINSTANCE BORS(175,120) /* Maximum number of different tokeninstances */
-#define MAXSTRINGS BORS(600,400)/* Maximum number of different codestrings */
-#define MAXPATTERN BORS(7000,6000) /* Maximum number of bytes in pattern[] */
-#define MAXNODES BORS(450,350) /* Maximum number of expression nodes */
-#define MAXMEMBERS 2 /* Maximum number of subregisters per reg */
-#define NMOVES BORS(50,30) /* Maximum number of move definitions */
-#define MAXC1 20 /* Maximum of coercions type 1 */
-#define MAXC2 20 /* Maximum of coercions type 2 */
-#define MAXC3 20 /* Maximum of coercions type 3 */
-#define MAXSPLIT 4 /* Maximum degree of split */
-#define MAXNSTR 40 /* Maximum consecutive strings in coderule */
-
-/* Derived constants */
-
-#define SETSIZE ((MAXREGS+1+MAXTOKENS+15)>>4)
-#define PROPSETSIZE ((MAXPROPS+15)>>4)
-
-#define BMASK 0377
-#define BSHIFT 8
-
-#define TRUE 1
-#define FALSE 0
-
-#define MAXPATLEN 7 /* Maximum length of tokenpatterns */
-
-typedef char byte;
-typedef char * string;
-
-#include <stdio.h>
-#include <assert.h>
-#include <ctype.h>
-#include <em_spec.h>
-#include <em_flag.h>
-#include <em_reg.h>
-#include <cg_pattern.h>
-
-typedef struct list1str {
- struct list1str *l1next;
- string l1name;
-} *list1;
-typedef struct list2str {
- struct list2str *l2next;
- list1 l2list;
-} *list2;
-typedef struct list3str {
- struct list3str *l3next;
- list2 l3list;
-} *list3;
-
-typedef struct reginfo {
- string rname;
- string rrepr;
- int rsize;
- int rmembers[MAXMEMBERS];
- int rregvar;
- short rprop[PROPSETSIZE];
-} *reginfo;
-
-typedef struct tokeninfo {
- string t_name;
- list2 t_struct;
- struct {
- int t_type;
- string t_sname;
- } t_fields[TOKENSIZE-1];
- int t_size;
- cost_t t_cost;
- int t_format;
-} token_t,*token_p;
-
-typedef struct ident {
- struct ident *i_next;
- string i_name;
- int i_type;
-# define IREG 1
-# define IPRP 2
-# define ITOK 3
-# define IEXP 4
- union {
- int i_regno;
- int i_prpno;
- int i_tokno;
- int i_expno;
- } i_i;
-} ident_t,*ident_p;
-
-#define ITABSIZE 32
-ident_p identtab[ITABSIZE];
-
-#define LOOKUP 0
-#define HALFWAY 1
-#define ENTER 2
-#define JUSTLOOKING 3
-
-
-typedef struct expr {
- int expr_typ;
-# define TYPINT 1
-# define TYPREG 2
-# define TYPSTR 3
-# define TYPBOOL 4
- int expr_index;
-} expr_t,*expr_p;
-
-unsigned cc1=1,cc2=1,cc3=1,cc4=1;
-
-node_t nodes[MAXNODES];
-node_p lastnode=nodes+1;
-
-string codestrings[MAXSTRINGS];
-int ncodestrings;
-
-int strar[MAXNSTR];
-int nstr;
-
-int pathash[256];
-
-reginfo machregs[MAXREGS];
-char stregclass[MAXREGS];
-int nmachregs=1;
-int nregclasses=1;
-int maxmembers;
-struct {
- ident_p propname;
- set_t propset;
-} machprops[MAXPROPS];
-int nprops=0;
-token_t machtokens[MAXTOKENS];
-int nmachtokens=1;
-set_t machsets[MAXSETS];
-int nmachsets=0;
-int patmnem[MAXEMPATLEN];
-int empatlen;
-int maxempatlen;
-int empatexpr;
-int maxrule=1;
-int pattokexp[MAXPATLEN];
-int tokpatlen;
-int lookident=0; /* lexical analyzer flag */
-list3 structpool=0;
-int nallreg;
-int allreg[MAXALLREG];
-int maxallreg;
-int lino=0;
-int nerrors=0;
-int curtokexp;
-expr_t arexp[TOKENSIZE];
-int narexp;
-inst_t arinstance[MAXINSTANCE];
-int narinstance=1;
-move_t machmoves[NMOVES];
-int nmoves=0;
-byte pattern[MAXPATTERN];
-int npatbytes=0;
-int prevind;
-int rulecount; /* Temporary index for ... construct */
-int ncoderules=0;
-int codebytes=0;
-FILE *cfile;
-FILE *hfile;
-int maxtokensize=0;
-int dealflag;
-int emrepllen;
-int replmnem[MAXEMPATLEN];
-int tokrepllen;
-int replinst[MAXPATLEN];
-int replexpr[MAXPATLEN];
-c1_t c1coercs[MAXC1];
-c2_t c2coercs[MAXC2];
-c3_t c3coercs[MAXC3];
-int nc1=0,nc2=0,nc3=0;
-int maxsplit=0;
-int wsize= -1;
-int psize= -1;
-int bsize= -1;
-char *fmt=0;
-
-int cchandled;
-int ccspoiled;
-int ccregexpr;
-int ccinstanceno;
-int cocopropno;
-int cocosetno;
-int allexpno;
-
-int rvused; /* regvars used */
-int nregvar[4]; /* # of register variables of all kinds */
-int rvnumbers[4][MAXREGVARS]; /* The register numbers */
-
-#define chktabsiz(size,maxsize,which) if(size>=maxsize) tabovf(which)
-
-#define MUST1BEINT(e) int exp1=e.expr_index;tstint(e)
-#define MUST2BEINT(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstint(e1);tstint(e2)
-#define MUST1BEBOOL(e) int exp1=e.expr_index;tstbool(e)
-#define MUST2BEBOOL(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstbool(e1);tstbool(e2)
-
-%}
-
-%union {
- int yy_int;
- int *yy_intp;
- string yy_string;
- list1 yy_list1;
- list2 yy_list2;
- expr_t yy_expr;
- cost_t yy_cost;
- set_t yy_set;
- ident_p yy_ident;
- char yy_char;
- inst_t yy_instance;
-}
-
-%type <yy_list1> list1,structlistel
-%type <yy_list2> structlist,structdecl
-%type <yy_expr> expr optexpr
-%type <yy_cost> optcost cost optcommacost
-%type <yy_int> optboolexpr optnocoerc mnem emargno tokargno optprop
-%type <yy_int> optcommabool optstack subreg tokenexpressionno optregvar
-%type <yy_int> tokeninstanceno code stackreplacement optslashnumber
-%type <yy_set> tokenexpression
-%type <yy_instance> tokeninstance
-%type <yy_string> optformat
-%token <yy_string> IDENT TYPENAME
-%token <yy_ident> RIDENT,PIDENT,TIDENT,EIDENT
-%token <yy_string> LSTRING,STRING
-%token <yy_int> NUMBER
-%token <yy_intp> CIDENT
-%token REGISTERHEAD TOKENHEAD EXPRESSIONHEAD CODEHEAD MOVEHEAD TESTHEAD STACKHEAD
-%token REGVAR INREG LOOP POINTER FLOAT
-%token TIMEFAC SIZEFAC FORMAT RETURN
-%token MOVE ERASE ALLOCATE ELLIPS COST REMOVE STACK
-%token SEP SAMESIGN SFIT UFIT ROM DEFINED TOSTRING LOWW HIGHW
-%token NOCC SETCC SAMECC TEST NOCOERC
-%token <yy_char> LCASELETTER
-%start machinespec
-
-%left OR2
-%left AND2
-%left CMPEQ,CMPNE
-%left CMPLT,CMPLE,CMPGT,CMPGE
-%left RSHIFT,LSHIFT
-%left '+','-'
-%left '*','/','%'
-%nonassoc NOT,COMP,UMINUS
-%nonassoc '$'
-%%
-machinespec
- : rcsid constants registersection tokensection
- { inbetween(); }
- expressionsection codesection movesection testsection stacksection
- ;
-
-rcsid
- : /* empty */
- | STRING
- { strlookup($1); }
- ;
-
-constants
- : /* empty */
- | constants CIDENT '=' NUMBER
- { *$2 = $4; }
- | constants SIZEFAC '=' NUMBER optslashnumber
- { cc1 = $4; cc2 = $5; }
- | constants TIMEFAC '=' NUMBER optslashnumber
- { cc3 = $4; cc4 = $5; }
- | constants FORMAT '=' STRING
- { fmt = $4; }
- ;
-optslashnumber
- : /* empty */
- { $$ = 1; }
- | '/' NUMBER
- { $$ = $2; }
- ;
-
-registersection
- : REGISTERHEAD registerdefs
- ;
-registerdefs
- : /* empty */
- | registerdefs registerdef
- ;
-
-registerdef
- : IDENT '=' '(' STRING ',' NUMBER list1 ')' optregvar list1 '.'
- { register ident_p ip;
- register list1 l;
- register reginfo r;
- int i;
-
- r=(reginfo) myalloc(sizeof(struct reginfo));
- r->rname = $1;
- r->rrepr = $4;
- r->rsize = $6;
- if($9>=0 && $7!=0)
- yyerror("No subregisters allowed in regvar");
- for (i=0;i<MAXMEMBERS;i++)
- r->rmembers[i] = 0;
- i=0;
- for (l=$7;l!=0;l=l->l1next) {
- ip=ilookup(l->l1name,LOOKUP);
- if (ip->i_type != IREG)
- yyerror("Bad member of set");
- chktabsiz(i,MAXMEMBERS,"Member of register");
- r->rmembers[i++] = ip->i_i.i_regno;
- }
- maxmembers=max(maxmembers,i);
- r->rregvar=$9;
- if ($9>=0) {
- rvused=1;
- chktabsiz(nregvar[$9],MAXREGVARS,"Regvar");
- rvnumbers[$9][nregvar[$9]++] = nmachregs;
- }
- for(i=0;i<PROPSETSIZE;i++)
- r->rprop[i] = 0;
- ip=ilookup($1,ENTER);
- ip->i_type=IREG;
- ip->i_i.i_regno=nmachregs;
- for (l = $10; l!= 0; l=l->l1next) {
- ip = ilookup(l->l1name,HALFWAY);
- if (ip->i_type) {
- if (ip->i_type != IPRP)
- yyerror("Multiple defined symbol");
- else if(machprops[ip->i_i.i_prpno].propset.set_size != r->rsize)
- yyerror("property has more than 1 size");
- } else {
- chktabsiz(nprops,MAXPROPS,"Property");
- ip->i_type = IPRP;
- ip->i_i.i_prpno = nprops;
- machprops[nprops].propname = ip;
- machprops[nprops++].propset.set_size = r->rsize;
- }
- r->rprop[ip->i_i.i_prpno>>4] |= (1<<(ip->i_i.i_prpno&017));
- }
- chktabsiz(nmachregs,MAXREGS,"Register table");
- machregs[nmachregs++] = r;
- }
- | error '.'
- ;
-
-optregvar
- : /* nothing */
- { $$ = -1; }
- | REGVAR
- { $$ = reg_any; }
- | REGVAR '(' LOOP ')'
- { $$ = reg_loop; }
- | REGVAR '(' POINTER ')'
- { $$ = reg_pointer; }
- | REGVAR '(' FLOAT ')'
- { $$ = reg_float; }
- ;
-
-tokensection
- : TOKENHEAD tkdefs
- ;
-tkdefs
- : /* empty */
- | tkdefs tkdef
- ;
-tkdef
- : IDENT '=' structdecl NUMBER optcost optformat
- { register token_p tp;
- register ident_p ip;
-
- chktabsiz(nmachtokens,MAXTOKENS,"Token table");
- tp = &machtokens[nmachtokens];
- tp->t_name = $1;
- tp->t_struct = $3;
- tp->t_size = $4;
- tp->t_cost = $5;
- ip = ilookup($1,ENTER);
- ip->i_type = ITOK;
- ip->i_i.i_tokno = nmachtokens++;
- maxtokensize=max(maxtokensize,structsize($3));
- setfields(tp,$6);
- }
- | error
- ;
-structdecl
- : '{' structlist '}'
- { $$ = lookstruct($2); }
- ;
-structlist
- : /* empty */
- { $$=0; }
- | structlistel structlist
- { $$=(list2) myalloc(sizeof(struct list2str));
- $$->l2next = $2;
- $$->l2list = $1;
- }
- ;
-structlistel
- : TYPENAME list1 ';'
- { $$=(list1) myalloc(sizeof(struct list1str));
- $$->l1next = $2;
- $$->l1name = $1;
- }
- ;
-
-optcost : /* empty */
- { $$.c_size = $$.c_time = 0; }
- | COST '=' '(' expr ',' expr ')'
- { MUST2BEINT($4,$6);
- $$.c_size = exp1;
- $$.c_time = exp2;
- }
- ;
-optformat
- : /* empty */
- { $$ = 0; }
- | STRING
- ;
-
-expressionsection
- : /* empty */
- | EXPRESSIONHEAD tokenexpressions
- ;
-tokenexpressions
- : tokenexpressionline
- | tokenexpressionline tokenexpressions
- ;
-tokenexpressionline
- : IDENT '=' tokenexpression
- {
- { register ident_p ip;
-
- chktabsiz(nmachsets,MAXSETS,"Expression table");
- machsets[nmachsets] = $3;
- ip=ilookup($1,ENTER);
- ip->i_type = IEXP;
- ip->i_i.i_expno = nmachsets++;
- }
- }
- | error
- ;
-tokenexpression
- : PIDENT
- { $$ = machprops[$1->i_i.i_prpno].propset; }
- | TIDENT
- { register i;
-
- for(i=0;i<SETSIZE;i++) $$.set_val[i]=0;
- $$.set_val[($1->i_i.i_tokno+nmachregs+1)>>4] |=
- 01<<(($1->i_i.i_tokno+nmachregs+1)&017);
- $$.set_size = machtokens[$1->i_i.i_tokno].t_size;
- }
- | EIDENT
- { $$=machsets[$1->i_i.i_expno]; }
- | tokenexpression '*' tokenexpression
- { register i;
-
- if (($$.set_size=$1.set_size)==0)
- $$.set_size = $3.set_size;
- for (i=0;i<SETSIZE;i++)
- $$.set_val[i] = $1.set_val[i] & $3.set_val[i];
- }
- | tokenexpression '+' tokenexpression
- { register i;
-
- if ($1.set_size == -1)
- $$.set_size = $3.set_size;
- else if ($3.set_size == -1)
- $$.set_size = $1.set_size;
- else if ($1.set_size == $3.set_size)
- $$.set_size = $1.set_size;
- else
- $$.set_size = 0;
- for (i=0;i<SETSIZE;i++)
- $$.set_val[i] = $1.set_val[i] | $3.set_val[i];
- }
- | tokenexpression '-' tokenexpression
- { register i;
-
- if ($1.set_size == -1)
- $$.set_size = $3.set_size;
- else if ($3.set_size == -1)
- $$.set_size = $1.set_size;
- else if ($1.set_size == $3.set_size)
- $$.set_size = $1.set_size;
- else
- $$.set_size = 0;
- for (i=0;i<SETSIZE;i++)
- $$.set_val[i] = $1.set_val[i] & ~ $3.set_val[i];
- }
- | '(' tokenexpression ')'
- { $$ = $2; }
- ;
-
-codesection
- : CODEHEAD coderules
- ;
-coderules
- : coderule
- | coderules coderule
- ;
-coderule
- : { nallreg=emrepllen=tokrepllen=0; }
- empattern SEP stackpattern SEP code SEP stackreplacement SEP
- emreplacement SEP cost
- { int i;
-
- if (emrepllen) {
- outbyte(DO_EMREPLACE+(emrepllen<<5));
- for (i=0;i<emrepllen;i++) {
- out(replmnem[i]);
- out(replexpr[i]);
- }
- }
- if ($8==0) {
- outbyte(DO_TOKREPLACE+(tokrepllen<<5));
- for(i=0;i<tokrepllen;i++)
- out(replinst[i]);
- } else {
- static int warncount=0;
- if (!warncount++)
- fprintf(stderr,
- "WARNING: convert to stacksection, will disappear soon");
- outbyte(DO_TOKREPLACE);
- }
- if ($12.c_size!=0 || $12.c_time!=0) {
- outbyte(DO_COST);
- out($12.c_size);
- out($12.c_time);
- }
- outbyte(empatlen==0? DO_RETURN : DO_NEXTEM);
- fprintf(cfile,"\n");
- ncoderules++;
- maxallreg=max(maxallreg,nallreg);
- if (empatlen==0) { /* coercion */
- if (tokrepllen<1 && $8==0)
- yyerror("No replacement in coercion");
- if (tokpatlen>1)
- yyerror("Token pattern too long");
- if ($8!=0) { /* stacking */
- c1_p cp;
- chktabsiz(nc1,MAXC1,"Coerc table 1");
- cp = &c1coercs[nc1++];
- cp->c1_texpno = pattokexp[1];
- cp->c1_prop = -1;
- cp->c1_codep = $6;
- } else if (tokrepllen>1) { /* splitting */
- c2_p cp;
- chktabsiz(nc2,MAXC2,"Coerc table 2");
- cp= &c2coercs[nc2++];
- cp->c2_texpno = pattokexp[1];
- cp->c2_nsplit = tokrepllen;
- maxsplit=max(maxsplit,tokrepllen);
- for (i=0;i<tokrepllen;i++)
- cp->c2_repl[i] = replinst[i];
- cp->c2_codep = $6;
- if (nallreg>0)
- yyerror("No allocates allowed here");
- } else { /* one to one coercion */
- c3_p cp;
- chktabsiz(nc3,MAXC3,"Coerc table 3");
- cp= &c3coercs[nc3++];
- if (tokpatlen)
- cp->c3_texpno = pattokexp[1];
- else
- cp->c3_texpno = 0;
- if (nallreg>1)
- yyerror("Too many allocates in coercion");
- cp->c3_prop = nallreg==0 ? 0 : allreg[0];
- cp->c3_repl = replinst[0];
- cp->c3_codep = $6;
- }
- }
- }
- | error
- ;
-empattern
- : /* empty */
- { empatlen=0; }
- | mnemlist optboolexpr
- { register i;
-
- empatexpr = $2;
- patbyte(0);
- patshort(prevind);
- prevind = npatbytes - 3;
- maxempatlen = max(empatlen,maxempatlen);
- pat(empatlen);
- for(i=1;i<=empatlen;i++)
- patbyte(patmnem[i]);
- pat(empatexpr);
- rulecount = npatbytes;
- patbyte(1); /* number of different rules with this pattern */
- pat(codebytes); /* first rule */
- }
- | ELLIPS
- { pattern[rulecount]++;
- maxrule= max(maxrule,pattern[rulecount]);
- pat(codebytes);
- }
- ;
-
-mnemlist
- : mnem
- { empatlen = 1; patmnem[empatlen] = $1; }
- | mnemlist mnem
- { chktabsiz(empatlen+1,MAXEMPATLEN,"EM pattern");
- patmnem[++empatlen] = $2;
- }
- ;
-mnem : IDENT
- { if(strlen($1)!=3 || ($$=mlookup($1))==0)
- yyerror("not an EM-mnemonic");
- }
- ;
-
-stackpattern
- : optnocoerc tokenexpressionlist optstack
- { register i;
-
- if (tokpatlen != 0) {
- outbyte(($1 ? ( $3 ? DO_XXMATCH: DO_XMATCH ) : DO_MATCH)+(tokpatlen<<5));
- for(i=1;i<=tokpatlen;i++) {
- out(pattokexp[i]);
- }
- }
- if ($3 && tokpatlen==0 && empatlen==0) {
- outbyte(DO_COERC);
- }
- if ($3 && !$1 && empatlen!=0) {
- outbyte(DO_REMOVE);
- out(allexpno);
- }
- }
- ;
-
-optnocoerc
- : /* empty */
- { $$ = 0; }
- | NOCOERC ':'
- { $$ = 1; }
- ;
-
-tokenexpressionlist
- : /* empty */
- { tokpatlen = 0; }
- | tokenexpressionlist tokenexpressionno
- { chktabsiz(tokpatlen+1,MAXPATLEN,"Token pattern");
- pattokexp[++tokpatlen] = $2;
- if (machsets[$2].set_size==0)
- yyerror("Various sized set in tokenpattern");
- }
- ;
-
-tokenexpressionno
- : tokenexpression
- { $$ = exprlookup($1); }
- ;
-
-optstack
- : /* empty */
- { $$ = 0; }
- | STACK
- { $$ = 1; }
- ;
-
-code :
- { $$ = codebytes; cchandled=ccspoiled=0; }
- initcode restcode
- { if (cchandled==0 && ccspoiled!=0) {
- outbyte(DO_ERASE);
- out(ccregexpr);
- }
- }
- ;
-
-initcode
- : /* empty */
- | initcode remove
- | initcode allocate
- ;
-remove
- : REMOVE '(' tokenexpressionno
- { curtokexp = $3; }
- optcommabool ')'
- { outbyte(DO_REMOVE+ ($5!=0 ? 32 : 0));
- out($3);
- if ($5!=0) out($5);
- }
- | REMOVE '(' expr ')'
- { if ($3.expr_typ != TYPREG)
- yyerror("Expression must be register");
- outbyte(DO_RREMOVE);
- out($3.expr_index);
- }
- ;
-optcommabool
- : /* empty */
- { $$ = 0; }
- | ',' expr
- { MUST1BEBOOL($2);
- $$ = exp1;
- }
- ;
-
-restcode: /* empty */
- | restcode LSTRING expr
- { outbyte(DO_LOUTPUT);
- out(stringno($2));
- free($2);
- out($3.expr_index);
- ccspoiled++;
- }
- | restcode stringlist
- { int i;
- for(i=0;nstr>0;i++,nstr--) {
- if (i%8==0) outbyte(DO_ROUTPUT+(nstr>7 ? 7 : nstr-1)*32);
- out(strar[i]);
- }
- ccspoiled++;
- }
- | restcode RETURN
- { outbyte(DO_PRETURN); }
- | restcode move
- | restcode erase
- | restcode NOCC
- { outbyte(DO_ERASE);
- out(ccregexpr);
- cchandled++;
- }
- | restcode SAMECC
- { cchandled++; }
- | restcode SETCC '(' tokeninstanceno ')'
- { outbyte(DO_MOVE);
- out(ccinstanceno);
- out($4);
- cchandled++;
- }
- | restcode TEST '(' tokeninstanceno ')'
- { outbyte(DO_MOVE);
- out($4);
- out(ccinstanceno);
- ccspoiled=0;
- }
- ;
-
-stringlist
- : STRING
- { nstr=1;
- strar[0]=stringno($1);
- free($1);
- }
- | stringlist STRING
- { chktabsiz(nstr,MAXNSTR,"Consecutiv strings");
- strar[nstr++] = stringno($2);
- free($2);
- }
- ;
-
-move
- : MOVE '(' tokeninstanceno ',' tokeninstanceno ')'
- { outbyte(DO_MOVE);
- out($3);
- out($5);
- }
- ;
-
-erase
- : ERASE '(' expr ')'
- { outbyte(DO_ERASE);
- out($3.expr_index);
- if($3.expr_typ != TYPREG)
- yyerror("Bad argument of erase");
- }
- ;
-
-allocate
- : ALLOCATE { dealflag=0; } '(' alloclist ')'
- { if (dealflag)
- outbyte(DO_REALLOCATE);
- }
- ;
-
-
-alloclist
- : allocel
- | alloclist optcomma allocel
- ;
-
-allocel
- : tokeninstanceno /* deallocate */
- { outbyte(DO_DEALLOCATE);
- out($1);
- dealflag++;
- }
- | PIDENT
- { allreg[nallreg++] = $1->i_i.i_prpno;
- outbyte(DO_ALLOCATE);
- out($1->i_i.i_prpno);
- }
- | PIDENT '=' tokeninstanceno
- { allreg[nallreg++] = $1->i_i.i_prpno;
- outbyte(DO_ALLOCATE+32);
- out($1->i_i.i_prpno);
- out($3);
- }
- ;
-
-stackreplacement
- : /* empty */
- { $$=0; }
- | STACK
- { $$=1; }
- | '{' STACK '}'
- { $$=1; }
- | stackrepllist
- { $$=0; }
- ;
-stackrepllist
- : tokeninstanceno
- { tokrepllen=1; replinst[0] = $1; }
- | stackrepllist tokeninstanceno
- { chktabsiz(tokrepllen+1,MAXPATLEN,"Stack replacement");
- replinst[tokrepllen++] = $2;
- }
- ;
-
-emreplacement
- : /* empty, normal case */
- | emrepllist
- ;
-emrepllist
- : mnem optexpr
- { emrepllen=1;
- replmnem[0]=$1;
- replexpr[0]=$2.expr_index;
- }
- | emrepllist mnem optexpr
- { chktabsiz(emrepllen+1,MAXEMPATLEN,"EM replacement");
- replmnem[emrepllen]=$2;
- replexpr[emrepllen]=$3.expr_index;
- emrepllen++;
- }
- ;
-
-cost : /* empty */
- { $$.c_size = $$.c_time = 0;
- }
- | '(' expr ',' expr ')'
- { MUST2BEINT($2,$4);
- $$.c_size = exp1;
- $$.c_time = exp2;
- }
- | cost '+' '%' '[' tokargno ']'
- { $$.c_size = lookup(1,EX_PLUS,$1.c_size,
- lookup(0,EX_COST,$5,0));
- $$.c_time = lookup(1,EX_PLUS,$1.c_time,
- lookup(0,EX_COST,$5,1));
- }
- ;
-
-movesection
- : MOVEHEAD movedefs
- ;
-
-movedefs
- : movedef
- | movedefs movedef
- ;
-
-movedef
- : '(' tokenexpressionno
- { curtokexp = $2; }
- optboolexpr ',' tokenexpressionno
- { curtokexp = $6;
- pattokexp[1] = $2;
- pattokexp[2] = $6;
- tokpatlen=2;
- }
- optboolexpr ',' code optcommacost ')'
- { register move_p mp;
-
- outbyte(DO_RETURN);
- fprintf(cfile,"\n");
- chktabsiz(nmoves,NMOVES,"Move definition table");
- mp = &machmoves[nmoves++];
- mp->m_set1 = $2;
- mp->m_expr1= $4;
- mp->m_set2 = $6;
- mp->m_expr2= $8;
- mp->m_cindex=$10;
- mp->m_cost = $11;
- }
- | error
- ;
-
-testsection
- : /* empty */
- | TESTHEAD testdefs
- ;
-
-testdefs: testdef
- | testdefs testdef
- ;
-
-testdef : '(' tokenexpressionno
- { curtokexp = $2;
- pattokexp[1] = $2;
- pattokexp[2] = cocosetno;
- tokpatlen=2;
- }
- optboolexpr ',' code optcommacost ')'
- { register move_p mp;
-
- outbyte(DO_RETURN);
- fprintf(cfile,"\n");
- chktabsiz(nmoves,NMOVES,"Move definition table(tests)");
- mp = &machmoves[nmoves++];
- mp->m_set1 = $2;
- mp->m_expr1 = $4;
- mp->m_set2 = cocosetno;
- mp->m_expr2 = 0;
- mp->m_cindex = $6;
- mp->m_cost = $7;
- }
- ;
-
-stacksection
- : STACKHEAD stackdefs
- | /* empty */
- ;
-stackdefs
- : stackdef
- | stackdefs stackdef
- ;
-stackdef
- : '(' tokenexpressionno
- { curtokexp = $2;
- pattokexp[1] = $2;
- tokpatlen=1;
- }
- optboolexpr ',' optprop ',' code optcommacost ')'
- { register c1_p cp;
-
- outbyte(DO_TOKREPLACE);
- outbyte(DO_RETURN);
- fprintf(cfile,"\n");
- chktabsiz(nc1,MAXC1,"Stacking table");
- cp = &c1coercs[nc1++];
- cp->c1_texpno = $2;
- cp->c1_expr = $4;
- cp->c1_prop = $6;
- cp->c1_codep = $8;
- cp->c1_cost = $9;
- }
- ;
-
-optprop
- : /* empty */
- { $$ = -1; }
- | PIDENT
- { $$ = $1->i_i.i_prpno; }
- ;
-
-optcommacost
- : /* empty */
- { $$.c_size = 0; $$.c_time = 0;}
- | ',' cost
- { $$ = $2; }
- ;
-
-list1 : /* empty */
- { $$ = 0; }
- | optcomma IDENT list1
- { $$=(list1) myalloc(sizeof(struct list1str));
- $$->l1next = $3;
- $$->l1name = $2;
- }
- ;
-optcomma: /* nothing */
- | ','
- ;
-emargno : NUMBER
- { if ($1<1 || $1>empatlen)
- yyerror("Number after $ out of range");
- $$ = $1;
- }
- ;
-tokargno
- : NUMBER
- { if ($1<1 || $1>tokpatlen)
- yyerror("Number within %[] out of range");
- $$ = $1;
- }
- ;
-expr : '$' emargno
- { $$.expr_index = lookup(0,EX_ARG,$2,0); $$.expr_typ = argtyp(patmnem[$2]);
- }
- | NUMBER
- { $$.expr_index = lookup(0,EX_CON,(int)($1&0177777),(int)($1>>16));
- $$.expr_typ = TYPINT;
- }
- | STRING
- { $$.expr_index = lookup(0,EX_STRING,strlookup($1),0);
- $$.expr_typ = TYPSTR;
- }
- | RIDENT
- { $$.expr_index = lookup(0,EX_REG,$1->i_i.i_regno,0);
- $$.expr_typ = TYPREG;
- }
- | '%' '[' tokargno '.' IDENT ']'
- { $$.expr_index = lookup(0,EX_TOKFIELD,$3,
- findstructel(pattokexp[$3],$5,&$$.expr_typ));
- }
- | '%' '[' tokargno subreg ']'
- { chkregexp(pattokexp[$3]);
- $$.expr_index = lookup(0,EX_SUBREG,$3,$4);
- $$.expr_typ = TYPREG;
- }
- | '%' '[' LCASELETTER subreg ']'
- { if ($3 >= 'a'+nallreg)
- yyerror("Bad letter in %[x] construct");
- $$.expr_index = lookup(0,EX_ALLREG,$3-'a'+1,$4);
- $$.expr_typ = TYPREG;
- }
- | '%' '[' IDENT ']'
- { $$.expr_index = lookup(0,EX_TOKFIELD,0,
- findstructel(curtokexp,$3,&$$.expr_typ));
- }
- | TOSTRING '(' expr ')'
- { MUST1BEINT($3);
- $$.expr_index = lookup(0,EX_TOSTRING,exp1,0);
- $$.expr_typ = TYPSTR;
- }
- | DEFINED '(' expr ')'
- { $$.expr_index = lookup(0,EX_DEFINED,$3.expr_index,0);
- $$.expr_typ = TYPBOOL;
- }
- | SAMESIGN '(' expr ',' expr ')'
- { MUST2BEINT($3,$5);
- $$.expr_index = lookup(1,EX_SAMESIGN,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | SFIT '(' expr ',' expr ')'
- { MUST2BEINT($3,$5);
- $$.expr_index = lookup(0,EX_SFIT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | UFIT '(' expr ',' expr ')'
- { MUST2BEINT($3,$5);
- $$.expr_index = lookup(0,EX_UFIT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | ROM '(' emargno ',' NUMBER ')'
- { if ($5<1 || $5>3)
- yyerror("Second argument of rom must be >=1 and <=3");
- $$.expr_index = lookup(0,EX_ROM,$3-1,$5-1);
- $$.expr_typ = TYPINT;
- }
- | LOWW '(' emargno ')'
- {
- $$.expr_index = lookup(0,EX_LOWW,$3-1,0);
- $$.expr_typ = TYPINT;
- }
- | HIGHW '(' emargno ')'
- {
- $$.expr_index = lookup(0,EX_HIGHW,$3-1,0);
- $$.expr_typ = TYPINT;
- }
- | '(' expr ')'
- { $$ = $2; }
- | expr CMPEQ expr
- { switch(commontype($1,$3)) {
- case TYPINT:
- $$.expr_index = lookup(1,EX_NCPEQ,$1.expr_index,$3.expr_index);
- break;
- case TYPSTR:
- $$.expr_index = lookup(1,EX_SCPEQ,$1.expr_index,$3.expr_index);
- break;
- case TYPREG:
- $$.expr_index = lookup(1,EX_RCPEQ,$1.expr_index,$3.expr_index);
- break;
- }
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPNE expr
- { switch(commontype($1,$3)) {
- case TYPINT:
- $$.expr_index = lookup(1,EX_NCPNE,$1.expr_index,$3.expr_index);
- break;
- case TYPSTR:
- $$.expr_index = lookup(1,EX_SCPNE,$1.expr_index,$3.expr_index);
- break;
- case TYPREG:
- $$.expr_index = lookup(1,EX_RCPNE,$1.expr_index,$3.expr_index);
- break;
- }
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPGT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPGT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPGE expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPGE,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPLT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPLT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPLE expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPLE,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr OR2 expr
- { MUST2BEBOOL($1,$3);
- $$.expr_index = lookup(0,EX_OR2,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr AND2 expr
- { MUST2BEBOOL($1,$3);
- $$.expr_index = lookup(0,EX_AND2,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr '+' expr
- { switch(commontype($1,$3)) {
- case TYPINT:
- $$.expr_index = lookup(1,EX_PLUS,$1.expr_index,$3.expr_index);
- break;
- case TYPSTR:
- $$.expr_index = lookup(0,EX_CAT,$1.expr_index,$3.expr_index);
- break;
- default:
- yyerror("Bad types");
- }
- $$.expr_typ = $1.expr_typ;
- }
- | expr '-' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_MINUS,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr '*' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(1,EX_TIMES,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr '/' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_DIVIDE,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr '%' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_MOD,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr LSHIFT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_LSHIFT,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr RSHIFT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_RSHIFT,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | NOT expr
- { MUST1BEBOOL($2);
- $$.expr_index = lookup(0,EX_NOT,exp1,0);
- $$.expr_typ = TYPBOOL;
- }
- | COMP expr
- { MUST1BEINT($2);
- $$.expr_index = lookup(0,EX_COMP,exp1,0);
- $$.expr_typ = TYPINT;
- }
- | INREG '(' expr ')'
- { MUST1BEINT($3);
- $$.expr_index = lookup(0,EX_INREG,exp1,0);
- $$.expr_typ = TYPINT;
- }
- | REGVAR '(' expr ')'
- { MUST1BEINT($3);
- $$.expr_index = lookup(0,EX_REGVAR,exp1,0);
- $$.expr_typ = TYPREG;
- }
-/*
- | '-' expr %prec UMINUS
- { MUST1BEINT($2);
- $$.expr_index = lookup(0,EX_UMINUS,exp1,0);
- $$.expr_typ = TYPINT;
- }
-*/
- ;
-
-subreg : /* empty */
- { $$=0; }
- | '.' NUMBER
- { $$=$2; }
- ;
-
-optboolexpr
- : /* empty */
- { $$ = 0; }
- | expr
- { MUST1BEBOOL($1);
- $$=exp1;
- }
- ;
-optexpr
- : /* empty */
- { $$.expr_typ=0;
- $$.expr_index=0;
- }
- | expr
- ;
-
-tokeninstanceno
- : tokeninstance
- { $$ = instno($1); }
- ;
-
-tokeninstance
- : '%' '[' tokargno subreg ']'
- { register i;
-
- if ($4!=0)
- chkregexp(pattokexp[$3]);
- $$.in_which = IN_COPY;
- $$.in_info[0] = $3;
- $$.in_info[1] = $4;
- for (i=2;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | '%' '[' tokargno '.' IDENT ']'
- { int typ;
- register i;
- $$.in_which = IN_COPY;
- $$.in_info[0] = $3;
- $$.in_info[1] = findstructel(pattokexp[$3],$5,&typ);
- if (typ != TYPREG)
- yyerror("Must be register");
- for (i=2;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | RIDENT
- { register i;
- $$.in_which = IN_RIDENT;
- $$.in_info[0] = $1->i_i.i_regno;
- for (i=1;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | REGVAR '(' expr ')'
- { register i;
- MUST1BEINT($3);
- $$.in_which = IN_REGVAR;
- $$.in_info[0] = exp1;
- for (i=1;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | '%' '[' LCASELETTER subreg ']'
- { register i;
- if ($3 >= 'a'+nallreg)
- yyerror("Bad letter in %[x] construct");
- $$.in_which = IN_ALLOC;
- $$.in_info[0] = $3-'a';
- $$.in_info[1] = $4;
- for (i=2;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | '{' TIDENT attlist '}'
- { register i;
- $$.in_which = IN_DESCR;
- $$.in_info[0] = $2->i_i.i_tokno;
- for(i=0;i<narexp;i++) {
- if (arexp[i].expr_typ !=
- machtokens[$2->i_i.i_tokno].t_fields[i].t_type)
- yyerror("Attribute %d has wrong type",i+1);
- $$.in_info[i+1] = arexp[i].expr_index;
- }
- for (i=narexp+1;i<TOKENSIZE;i++) {
- if (machtokens[$2->i_i.i_tokno].t_fields[i-1].t_type!=0)
- yyerror("Too few attributes");
- $$.in_info[i] = 0;
- }
- }
- ;
-
-attlist
- : /* empty */
- { narexp = 0; }
- | attlist ',' expr
- { arexp[narexp++] = $3; }
- ;
-
-%%
-
-char * myalloc(n) {
- register char *p;
-
- p= (char*) malloc(n);
- if (p==0) {
- yyerror("Out of core");
- exit(1);
- }
- return(p);
-}
-
-tstint(e) expr_t e; {
-
- if(e.expr_typ != TYPINT)
- yyerror("Must be integer expression");
-}
-
-tstbool(e) expr_t e; {
-
- if(e.expr_typ != TYPBOOL)
- yyerror("Must be boolean expression");
-}
-
-structsize(s) register list2 s; {
- register list1 l;
- register sum;
-
- sum = 0;
- while ( s != 0 ) {
- l = s->l2list->l1next;
- while ( l != 0 ) {
- sum++;
- l = l->l1next;
- }
- s = s->l2next;
- }
- return(sum);
-}
-
-list2 lookstruct(ll) list2 ll; {
- list3 l3;
- list2 l21,l22;
- list1 l11,l12;
-
- for (l3=structpool;l3 != 0;l3=l3->l3next) {
- for (l21=l3->l3list,l22=ll;l21!=0 && l22!=0;
- l21=l21->l2next,l22=l22->l2next) {
- for(l11=l21->l2list,l12=l22->l2list;
- l11!=0 && l12!=0 && strcmp(l11->l1name,l12->l1name)==0;
- l11=l11->l1next,l12=l12->l1next)
- ;
- if (l11!=0 || l12!=0)
- goto contin;
- }
- if(l21==0 && l22==0)
- return(l3->l3list);
- contin:;
- }
- l3 = (list3) myalloc(sizeof(struct list3str));
- l3->l3next=structpool;
- l3->l3list=ll;
- structpool=l3;
- return(ll);
-}
-
-instno(inst) inst_t inst; {
- register i,j;
-
- for(i=1;i<narinstance;i++) {
- if (arinstance[i].in_which != inst.in_which)
- continue;
- for(j=0;j<TOKENSIZE;j++)
- if(arinstance[i].in_info[j] != inst.in_info[j])
- goto cont;
- return(i);
- cont:;
- }
- chktabsiz(narinstance,MAXINSTANCE,"Instance table");
- arinstance[narinstance] = inst;
- return(narinstance++);
-}
-
-string scopy(s) string s; {
- register string t;
-
- t = (char *) myalloc(strlen(s)+1);
- strcpy(t,s);
- return(t);
-}
-
-strlookup(s) string s; {
- register i;
-
- for(i=0;i<ncodestrings;i++)
- if(strcmp(s,codestrings[i])==0)
- return(i);
- chktabsiz(ncodestrings,MAXSTRINGS,"string table");
- codestrings[ncodestrings] = scopy(s);
- return(ncodestrings++);
-}
-
-stringno(s) register string s; {
- char buf[256];
- register char *p=buf;
-
- while(*s != 0) switch(*s) {
- default:
- *p++ = *s++;
- continue;
- case '$':
- s++;
- switch(*s) {
- default:
- yyerror("Bad character after $ in codestring");
- case '$':
- *p++ = *s++;
- continue;
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- *p++ = argtyp(patmnem[*s-'0']) == TYPINT ?
- PR_EMINT : PR_EMSTR;
- *p++ = *s++ -'0';
- continue;
- }
- case '%':
- s++;
- if (*s != '[') {
- if(*s == '%') {
- *p++ = *s++;
- continue;
- } else
- yyerror("Bad character following %% in codestring");
- } else
- s++;
- if(isdigit(*s)) {
- int num;
- num = *s++ - '0';
- if (num<1 || num>tokpatlen)
- yyerror("Number within %[] out of range");
- if (*s == ']') {
- s++;
- *p++ = PR_TOK;
- *p++ = num;
- } else if (*s++ != '.')
- yyerror("Bad character following %%[digit in codestring");
- else {
- char field[256];
- register char *f=field;
- int type,offset;
-
- while( *s != ']' && *s != 0)
- *f++ = *s++;
- *f++ = 0;
- if (*s != ']')
- yyerror("Unterminated %[] construction in codestring");
- else
- s++;
- if (isdigit(field[0])) {
- chkregexp(pattokexp[num]);
- *p++ = PR_SUBREG;
- *p++ = num;
- *p++ = atoi(field);
- } else {
- offset = findstructel(pattokexp[num],field,&type);
- *p++ = PR_TOKFLD;
- *p++ = num;
- *p++ = offset;
- }
- }
- } else if (*s >= 'a' && *s < 'a'+nallreg) {
- int reg,subreg;
- reg = *s++ -'a'+1;
- if(*s == ']')
- subreg = 255;
- else {
- if (*s != '.')
- yyerror("Bad character following %%[x in codestring");
- s++;
- if(!isdigit(*s))
- yyerror("Bad character following %%[x. in codestring");
- subreg = *s - '0';
- s++;
- if(*s != ']')
- yyerror("Bad character following %%[x.y in codestring");
- }
- s++;
- *p++ = PR_ALLREG;
- *p++ = reg;
- *p++ = subreg;
- } else
- yyerror("Bad character following %%[ in codestring");
- }
- *p++ = 0;
- return(strlookup(buf));
-}
-
-tabovf(tablename) string tablename; {
- char buf[256];
-
- sprintf(buf,"%s overflow",tablename);
- yyerror(buf);
- exit(-1);
-}
-
-main(argc,argv) char *argv[]; {
-
- if (argc!=1) {
- fprintf(stderr,"%s is a filter, don't use arguments\n",argv[0]);
- exit(-1);
- }
- inithash();
- initio();
- inittables();
- yyparse();
- if (nerrors==0) {
- compueq();
- hashpatterns();
- finishio();
- verbose();
- }
- debug();
- exit(nerrors);
-}
-
-lookup(comm,operator,lnode,rnode) {
- register node_p p;
-
- for (p=nodes+1;p<lastnode;p++) {
- if (p->ex_operator != operator)
- continue;
- if (!(p->ex_lnode == lnode && p->ex_rnode == rnode ||
- comm && p->ex_lnode == rnode && p->ex_rnode == lnode))
- continue;
- return(p-nodes);
- }
- if (lastnode >= &nodes[MAXNODES])
- yyerror("node table overflow");
- lastnode++;
- p->ex_operator = operator;
- p->ex_lnode = lnode;
- p->ex_rnode = rnode;
- return(p-nodes);
-}
-
-compueq() {
- register i,j;
-
- for (i=1;i<nmachregs;i++) {
- for (j=1;j<i;j++)
- if (eqregclass(i,j)) {
- stregclass[i] = stregclass[j];
- break;
- }
- if (j==i)
- stregclass[i] = nregclasses++;
- }
-}
-
-eqregclass(r1,r2) {
- register reginfo rp1,rp2;
- register i;
- short regbits[(MAXREGS+15)>>4];
- int member;
-
- rp1 = machregs[r1]; rp2 = machregs[r2];
- for (i=0;i<((nprops+15)>>4);i++)
- if (rp1->rprop[i] != rp2->rprop[i])
- return(0);
- for (i=0;i<((MAXREGS+15)>>4);i++)
- regbits[i] = 0;
- for (i=0;i<maxmembers;i++) {
- if (member = rp1->rmembers[i])
- regbits[member>>4] |= (1<<(member&017));
- }
- for (i=0;i<maxmembers;i++) {
- member = rp2->rmembers[i];
- if (regbits[member>>4]&(1<<(member&017)))
- return(0);
- }
- return(1);
-}
-
-unsigned hash(name) register string name; {
- register unsigned sum;
- register i;
-
- for (sum=i=0;*name;i+=3)
- sum ^= (*name++)<<(i&07);
- return(sum);
-}
-
-ident_p ilookup(name,enterf) string name; int enterf; {
- register ident_p p,*pp;
-
- pp = &identtab[hash(name)%ITABSIZE];
- while (*pp != 0) {
- if (strcmp((*pp)->i_name,name)==0)
- if (enterf != ENTER)
- return(*pp);
- else
- yyerror("Multiply defined symbol");
- pp = &(*pp)->i_next;
- }
- if (enterf == LOOKUP)
- yyerror("Undefined symbol");
- if (enterf == JUSTLOOKING)
- return(0);
- p = *pp = (ident_p) myalloc(sizeof(ident_t));
- p->i_name = name;
- p->i_next = 0;
- p->i_type = 0;
- return(p);
-}
-
-initio() {
-
- if ((cfile=fopen("tables.c","w"))==NULL) {
- fprintf(stderr,"Can't create tables.c\n");
- exit(-1);
- }
- if ((hfile=fopen("tables.h","w"))==NULL) {
- fprintf(stderr,"Can't create tables.h\n");
- exit(-1);
- }
- fprintf(cfile,"#include \"param.h\"\n");
- fprintf(cfile,"#include \"tables.h\"\n");
- fprintf(cfile,"#include \"types.h\"\n");
- fprintf(cfile,"#include <cg_pattern.h>\n");
- fprintf(cfile,"#include \"data.h\"\n");
- fprintf(cfile,"\nbyte coderules[] = {\n");
- patbyte(0);
-}
-
-exprlookup(sett) set_t sett; {
- register i,j,ok;
-
- for(i=0;i<nmachsets;i++) {
- ok= (sett.set_size == machsets[i].set_size);
- for(j=0;j<SETSIZE;j++) {
- if (sett.set_val[j] == machsets[i].set_val[j])
- continue;
- ok=0;
- break;
- }
- if (ok)
- return(i);
- }
- chktabsiz(nmachsets,MAXSETS,"Expression table");
- machsets[nmachsets] = sett;
- return(nmachsets++);
-}
-
-inittables() {
- register reginfo r;
- register i;
- inst_t inst;
- set_t sett;
-
- nodes[0].ex_operator=EX_CON;
- nodes[0].ex_lnode=0;
- nodes[0].ex_rnode=0;
- cocopropno=nprops++;
- r=(reginfo)myalloc(sizeof(struct reginfo));
- r->rname = "cc reg";
- r->rrepr = "CC";
- r->rsize = -1;
- r->rregvar= -1;
- for(i=0;i<MAXMEMBERS;i++)
- r->rmembers[i] = 0;
- for(i=0;i<PROPSETSIZE;i++)
- r->rprop[i] = 0;
- r->rprop[cocopropno>>4] |= (1<<(cocopropno&017));
- chktabsiz(nmachregs,MAXREGS,"Register table");
- machregs[nmachregs++] = r;
- inst.in_which = IN_RIDENT;
- inst.in_info[0] = nmachregs-1;
- for(i=1;i<TOKENSIZE;i++)
- inst.in_info[i]=0;
- ccinstanceno=instno(inst);
- ccregexpr=lookup(0,EX_REG,nmachregs-1,0);
- sett.set_size=0;
- for (i=0;i<SETSIZE;i++)
- sett.set_val[i]=0;
- sett.set_val[nmachregs>>4] |= (01<<(nmachregs&017));
- cocosetno=exprlookup(sett);
-}
-
-outregs() {
- register i,j,k;
- static short rset[(MAXREGS+15)>>4];
- int t,ready;
-
- fprintf(cfile,"char stregclass[] = {\n");
- for (i=0;i<nmachregs;i++)
- fprintf(cfile,"\t%d,\n",stregclass[i]);
- fprintf(cfile,"};\n\nstruct reginfo machregs[] = {\n{0},\n");
- for (i=1;i<nmachregs;i++) {
- fprintf(cfile,"{%d,%d",strlookup(machregs[i]->rrepr),
- machregs[i]->rsize);
- if (maxmembers!=0) {
- fprintf(cfile,",{");
- for(j=0;j<maxmembers;j++)
- fprintf(cfile,"%d,",machregs[i]->rmembers[j]);
- /* now compute and print set of registers
- * that clashes with this register.
- * A register clashes with al its children (and theirs)
- * and with all their parents.
- */
- for (j=0;j<((MAXREGS+15)>>4);j++)
- rset[j]=0;
- rset[i>>4] |= (1<<(i&017));
- do {
- ready=1;
- for (j=1;j<nmachregs;j++)
- if (rset[j>>4]&(1<<(j&017)))
- for (k=0;k<maxmembers;k++)
- if ((t=machregs[j]->rmembers[k])!=0) {
- if ((rset[t>>4]&(1<<(t&017)))==0)
- ready=0;
- rset[t>>4] |= (1<<(t&017));
- }
- } while (!ready);
- do {
- ready=1;
- for (j=1;j<nmachregs;j++)
- for (k=0;k<maxmembers;k++)
- if ((t=machregs[j]->rmembers[k])!=0)
- if (rset[t>>4]&(1<<(t&017))) {
- if (rset[j>>4]&(1<<(j&017))==0)
- ready=0;
- rset[j>>4] |= (1<<(j&017));
- }
- } while (!ready);
- fprintf(cfile,"},{");
- for (j=0;j<((nmachregs+15)>>4);j++)
- fprintf(cfile,"%d,",rset[j]);
- fprintf(cfile,"}");
- }
- if (machregs[i]->rregvar>=0)
- fprintf(cfile,",1");
- fprintf(cfile,"},\n");
- }
- fprintf(cfile,"};\n\n");
-}
-
-finishio() {
- register i;
- register node_p np;
- int j;
- int setsize;
- register move_p mp;
-
- fprintf(cfile,"};\n\n");
- if (wsize>0)
- fprintf(hfile,"#define EM_WSIZE %d\n",wsize);
- else
- yyerror("Wordsize undefined");
- if (psize>0)
- fprintf(hfile,"#define EM_PSIZE %d\n",psize);
- else
- yyerror("Pointersize undefined");
- if (bsize>=0)
- fprintf(hfile,"#define EM_BSIZE %d\n",bsize);
- else
- fprintf(hfile,"extern int EM_BSIZE;\n");
- if (fmt!=0)
- fprintf(hfile,"#define WRD_FMT \"%s\"\n",fmt);
- fprintf(hfile,"#define MAXALLREG %d\n",maxallreg);
- setsize = (nmachregs+1 + nmachtokens + 15)>>4;
- fprintf(hfile,"#define SETSIZE %d\n",setsize);
- fprintf(hfile,"#define NPROPS %d\n",nprops);
- fprintf(hfile,"#define NREGS %d\n",nmachregs);
- fprintf(hfile,"#define REGSETSIZE %d\n",(nmachregs+15)>>4);
- fprintf(hfile,"#define TOKENSIZE %d\n",maxtokensize);
- fprintf(hfile,"#define MAXMEMBERS %d\n",maxmembers);
- fprintf(hfile,"#define LONGESTPATTERN %d\n",maxempatlen);
- fprintf(hfile,"#define MAXRULE %d\n",maxrule);
- fprintf(hfile,"#define NMOVES %d\n",nmoves);
- fprintf(hfile,"#define NC1 %d\n",nc1);
- if (nc2) {
- assert(maxsplit!=0);
- fprintf(hfile,"#define NC2 %d\n",nc2);
- fprintf(hfile,"#define MAXSPLIT %d\n",maxsplit);
- }
- fprintf(hfile,"#define NC3 %d\n",nc3);
- outregs();
- fprintf(cfile,"tkdef_t tokens[] = {\n");
- for(i=0;i<nmachtokens;i++) {
- fprintf(cfile,"{%d,{%d,%d},{",machtokens[i].t_size,
- machtokens[i].t_cost.c_size,
- machtokens[i].t_cost.c_time);
- for(j=0;j<maxtokensize;j++)
- fprintf(cfile,"%d,",machtokens[i].t_fields[j].t_type);
- fprintf(cfile,"},%d},\n",machtokens[i].t_format);
- }
- fprintf(cfile,"};\n\nnode_t enodes[] = {\n");
- for(np=nodes;np<lastnode;np++)
- fprintf(cfile,"{%d,%d,%d},\n",np->ex_operator,np->ex_lnode,
- np->ex_rnode);
- fprintf(cfile,"};\n\nstring codestrings[] = {\n");
- for(i=0;i<ncodestrings;i++) {
- register char *p;
- p=codestrings[i];
- fprintf(cfile,"\t\"");
- while (*p) {
- fprintf(cfile, !isascii(*p) || iscntrl(*p) ? "\\%03o" : "%c", (*p)&BMASK);
- p++;
- }
- fprintf(cfile,"\",\n");
- }
- fprintf(cfile,"};\n\nset_t machsets[] = {\n");
- for(i=0;i<nmachsets;i++) {
- fprintf(cfile,"{%d,{",machsets[i].set_size);
- for(j=0;j<setsize;j++)
- fprintf(cfile,"0%o,",machsets[i].set_val[j]);
- fprintf(cfile,"}},\n");
- }
- fprintf(cfile,"};\n\ninst_t tokeninstances[] = {\n");
- for(i=0;i<narinstance;i++) {
- fprintf(cfile,"{ %d, {",arinstance[i].in_which);
- for(j=0;j<=maxtokensize;j++)
- fprintf(cfile,"%d,",arinstance[i].in_info[j]);
- fprintf(cfile,"}},\n");
- }
- fprintf(cfile,"};\n\nmove_t moves[] = {\n");
- for (i=0;i<nmoves;i++) {
- mp = &machmoves[i];
- fprintf(cfile,"{%d,%d,%d,%d,%d,{%d,%d}},\n",
- mp->m_set1, mp->m_expr1,
- mp->m_set2, mp->m_expr2,
- mp->m_cindex,
- mp->m_cost.c_size,mp->m_cost.c_time);
- }
- fprintf(cfile,"};\n\nbyte pattern[] = {\n");
- for (i=0;i<npatbytes;i++) {
- fprintf(cfile,"%3d,",pattern[i]&BMASK);
- if ((i%10)==9)
- fprintf(cfile,"\n");
- }
- fprintf(cfile,"\n};\n\nint pathash[256] = {\n");
- for(i=0;i<256;i++) {
- fprintf(cfile,"%6d,",pathash[i]);
- if((i&07)==07)
- fprintf(cfile,"\n");
- }
- fprintf(cfile,"};\n\nc1_t c1coercs[] = {\n");
- for (i=0;i<nc1;i++)
- fprintf(cfile,"{%d,%d,%d,%d,{%d,%d}},\n",
- c1coercs[i].c1_texpno,
- c1coercs[i].c1_expr,
- c1coercs[i].c1_prop,
- c1coercs[i].c1_codep,
- c1coercs[i].c1_cost.c_size,
- c1coercs[i].c1_cost.c_time);
- if (nc2)
- fprintf(cfile,"};\n\nc2_t c2coercs[] = {\n");
- for (i=0;i<nc2;i++) {
- fprintf(cfile,"{%d,%d,{",
- c2coercs[i].c2_texpno,
- c2coercs[i].c2_nsplit);
- for (j=0;j<maxsplit;j++)
- fprintf(cfile,"%d,",c2coercs[i].c2_repl[j]);
- fprintf(cfile,"},%d},\n",c2coercs[i].c2_codep);
- }
- fprintf(cfile,"};\n\nc3_t c3coercs[] = {\n");
- for (i=0;i<nc3;i++)
- fprintf(cfile,"{%d,%d,%d,%d},\n",
- c3coercs[i].c3_texpno,
- c3coercs[i].c3_prop,
- c3coercs[i].c3_repl,
- c3coercs[i].c3_codep);
- fprintf(cfile,"};\n\n");
- for (i=0;i<nprops;i++) {
- fprintf(cfile,"struct reginfo *rlist%02d[] = {\n",i);
- for (j=2;j<=nmachregs;j++) {
- if (machregs[j-1]->rregvar<0 &&
- (machprops[i].propset.set_val[j>>4]&(1<<(j&017))))
- fprintf(cfile,"\t&machregs[%d],\n",j-1);
- }
- fprintf(cfile,"\t0\n};\n");
- }
- fprintf(cfile,"struct reginfo **reglist[] = {\n");
- for (i=0;i<nprops;i++) {
- fprintf(cfile,"\trlist%02d,\n",i);
- }
- fprintf(cfile,"};\n");
- fprintf(cfile,"unsigned cc1 = %u;\n",cc1);
- fprintf(cfile,"unsigned cc2 = %u;\n",cc2);
- fprintf(cfile,"unsigned cc3 = %u;\n",cc3);
- fprintf(cfile,"unsigned cc4 = %u;\n",cc4);
- if (rvused)
- outregvar();
-}
-
-outregvar() {
- register i,j;
-
- fprintf(hfile,"#define REGVARS\n");
- fprintf(cfile,"#include \"regvar.h\"\n");
- fprintf(cfile,"int nregvar[4] = { ");
- for (i=0;i<4;i++) fprintf(cfile,"%d, ",nregvar[i]);
- fprintf(cfile,"};\n");
- for (i=0;i<4;i++)
- if (nregvar[i]>0)
- fprintf(cfile,"struct regassigned ratar%d[%d];\n",
- i,nregvar[i]);
- for (i=0;i<4;i++) if (nregvar[i]>0) {
- fprintf(cfile,"int rvtar%d[] = {",i);
- for (j=0;j<nregvar[i];j++)
- fprintf(cfile,"%d,",rvnumbers[i][j]);
- fprintf(cfile,"};\n");
- }
- fprintf(cfile,"\nint *rvnumbers[] = {\n");
- for (i=0;i<4;i++)
- if (nregvar[i]>0)
- fprintf(cfile,"\trvtar%d,\n",i);
- else
- fprintf(cfile,"\t0,\n");
- fprintf(cfile,"};\n\nstruct regassigned *regassigned[] = {\n");
- for (i=0;i<4;i++)
- if (nregvar[i]>0)
- fprintf(cfile,"\tratar%d,\n",i);
- else
- fprintf(cfile,"\t0,\n");
- fprintf(cfile,"};\n");
-}
-
-verbose() {
-
- fprintf(stderr,"Codebytes %d\n",codebytes);
- fprintf(stderr,"Registers %d(%d)\n",nmachregs,MAXREGS);
- fprintf(stderr,"Properties %d(%d)\n",nprops,MAXPROPS);
- fprintf(stderr,"Tokens %d(%d)\n",nmachtokens,MAXTOKENS);
- fprintf(stderr,"Sets %d(%d)\n",nmachsets,MAXSETS);
- fprintf(stderr,"Tokeninstances %d(%d)\n",narinstance,MAXINSTANCE);
- fprintf(stderr,"Strings %d(%d)\n",ncodestrings,MAXSTRINGS);
- fprintf(stderr,"Enodes %d(%d)\n",lastnode-nodes,MAXNODES);
- fprintf(stderr,"Patbytes %d(%d)\n",npatbytes,MAXPATTERN);
-}
-
-inbetween() {
- register ident_p ip;
- register i,j;
- register move_p mp;
-
- lookident=1; /* for lexical analysis */
-
- chktabsiz(nmachsets+1,MAXSETS,"Expressiontable");
- for (i=0;i<SETSIZE;i++)
- machsets[nmachsets].set_val[i] = 0xFFFF;
- machsets[nmachsets].set_val[0] &= ~1;
- machsets[nmachsets].set_size = 0;
- ip=ilookup("SCRATCH",ENTER);
- ip->i_type=IEXP;
- ip->i_i.i_expno = nmachsets++;
-
- for (i=0;i<SETSIZE;i++)
- machsets[nmachsets].set_val[i] = 0xFFFF;
- machsets[nmachsets].set_size = 0;
- ip=ilookup("ALL",ENTER);
- ip->i_type=IEXP;
- allexpno = ip->i_i.i_expno = nmachsets++;
- mp = &machmoves[nmoves++];
- mp->m_set1 = cocosetno;
- mp->m_expr1 = 0;
- mp->m_set2 = nmachsets-1;
- mp->m_expr2 = 0;
- mp->m_cindex = 0;
- mp->m_cost.c_size = 0;
- mp->m_cost.c_time = 0;
-
- /*
- * Create sets of registers per property
- */
-
- for (i=0;i<nprops;i++) {
- short *sp = machprops[i].propset.set_val;
-
- sp[0] |= 1;
- for (j=2;j<=nmachregs;j++)
- if (machregs[j-1]->rprop[i>>4]&(1<<(i&017)))
- sp[j>>4] |= (1<<(j&017));
- }
-}
-
-formconversion(p,tp) register char *p; register token_p tp; {
- char buf[256];
- register char *q=buf;
- char field[256];
- register char *f;
- int i;
-
- if (p==0)
- return(0);
- while (*p) switch(*p) {
- default: *q++ = *p++; continue;
- case '%':
- p++;
- if(*p == '%') {
- *q++ = *p++;
- continue;
- }
- if (*p == '[')
- p++;
- else
- yyerror("Bad character after % in format");
- f=field;
- while (*p != 0 && *p != ']')
- *f++ = *p++;
- *f++ = 0;
- if (*p == ']')
- p++;
- else
- yyerror("Unterminated %[] construct in format");
- for (i=0;i<TOKENSIZE-1;i++)
- if (strcmp(field,tp->t_fields[i].t_sname)==0)
- break;
- if (i==TOKENSIZE-1)
- yyerror("Unknown field in %[] construct in format");
- *q++ = i+1;
- }
- *q++ = 0;
- return(strlookup(buf));
-}
-
-setfields(tp,format) register token_p tp; string format; {
- register i;
- list2 ll;
- register list1 l;
- int type;
-
- for(i=0;i<TOKENSIZE-1;i++)
- tp->t_fields[i].t_type = 0;
- i=0;
- for(ll=tp->t_struct;ll!=0;ll=ll->l2next) {
- l=ll->l2list;
- if(strcmp(l->l1name,"REGISTER")==0)
- type = TYPREG;
- else if (strcmp(l->l1name,"INT")==0)
- type = TYPINT;
- else type = TYPSTR;
- for(l=l->l1next;l!=0;l=l->l1next) {
- tp->t_fields[i].t_type = type;
- tp->t_fields[i].t_sname = l->l1name;
- i++;
- }
- }
- if (format != 0)
- tp->t_format = formconversion(format,tp);
- else
- tp->t_format = -1;
-}
-
-chkregexp(number) {
- register i;
-
- for(i=nmachregs+1;i<nmachregs+1+nmachtokens;i++)
- if(machsets[number].set_val[i>>4]&(01<<(i&017)))
- yyerror("No tokens allowed in this set");
-}
-
-findstructel(number,name,t) string name; int *t; {
- register i;
- register token_p tp;
- register list2 structdecl;
- int offset;
-
- for(i=1;i<=nmachregs;i++)
- if (machsets[number].set_val[i>>4]&(01<<(i&017)))
- yyerror("No registers allowed in this set");
- structdecl = 0;
- for (i=nmachregs+1;i<nmachregs+1+nmachtokens;i++) {
- if (machsets[number].set_val[i>>4]&(01<<(i&017))) {
- if (structdecl == 0) {
- structdecl = machtokens[i-(nmachregs+1)].t_struct;
- tp = &machtokens[i-(nmachregs+1)];
- } else if(structdecl != machtokens[i-(nmachregs+1)].t_struct)
- yyerror("Multiple structs in this set");
- }
- }
- if (structdecl == 0) {
- yyerror("No structs in this set");
- return(0);
- }
- for(offset=0;offset<TOKENSIZE-1;offset++)
- if(tp->t_fields[offset].t_type != 0 &&
- strcmp(tp->t_fields[offset].t_sname,name)==0) {
- *t = tp->t_fields[offset].t_type;
- return(offset+1);
- }
- yyerror("No such field in this struct");
- return(0);
-}
-
-extern char em_flag[];
-
-argtyp(mn) {
-
- switch(em_flag[mn-sp_fmnem]&EM_PAR) {
- case PAR_W:
- case PAR_S:
- case PAR_Z:
- case PAR_O:
- case PAR_N:
- case PAR_L:
- case PAR_F:
- case PAR_R:
- case PAR_C:
- return(TYPINT);
- default:
- return(TYPSTR);
- }
-}
-
-commontype(e1,e2) expr_t e1,e2; {
-
- if(e1.expr_typ != e2.expr_typ)
- yyerror("Type incompatibility");
- return(e1.expr_typ);
-}
-
-extern char em_mnem[][4];
-
-#define HASHSIZE (2*(sp_lmnem-sp_fmnem))
-
-struct hashmnem {
- char h_name[3];
- byte h_value;
-} hashmnem[HASHSIZE];
-
-inithash() {
- register i;
-
- for(i=0;i<=sp_lmnem-sp_fmnem;i++)
- enter(em_mnem[i],i+sp_fmnem);
-}
-
-enter(name,value) char *name; {
- register unsigned h;
-
- h=hash(name)%HASHSIZE;
- while (hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- strncpy(hashmnem[h].h_name,name,3);
- hashmnem[h].h_value = value;
-}
-
-int mlookup(name) char *name; {
- register unsigned h;
-
- h = hash(name)%HASHSIZE;
- while (strncmp(hashmnem[h].h_name,name,3) != 0 &&
- hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- return(hashmnem[h].h_value&BMASK); /* 0 if not found */
-}
-
-hashpatterns() {
- short index;
- register byte *bp,*tp;
- register short i;
- unsigned short hashvalue;
- int patlen;
-
- index = prevind;
- while (index != 0) {
- bp = &pattern[index];
- tp = &bp[PO_MATCH];
- i = *tp++&BMASK;
- if (i==BMASK) {
- i = *tp++&BMASK;
- i |= (*tp++&BMASK)<<BSHIFT;
- }
- patlen = i;
- hashvalue = 0;
- switch(patlen) {
- default: /* 3 or more */
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 2:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 1:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- }
- assert(hashvalue!= ILLHASH);
- i=index;
- index = (bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<BSHIFT);
- bp[PO_HASH] = hashvalue>>BSHIFT;
- hashvalue &= BMASK;
- bp[PO_NEXT] = pathash[hashvalue]&BMASK;
- bp[PO_NEXT+1] = pathash[hashvalue]>>BSHIFT;
- pathash[hashvalue] = i;
- }
-}
-
-debug() {
- register i,j;
-
- for(i=0;i<ITABSIZE;i++) {
- register ident_p ip;
- for(ip=identtab[i];ip!=0;ip=ip->i_next)
- printf("%-14s %1d %3d\n",ip->i_name,
- ip->i_type,ip->i_i.i_regno);
- }
-
- for(i=2;i<nmachregs;i++) {
- register reginfo rp;
-
- rp=machregs[i];
- printf("%s = (\"%s\", %d",rp->rname,rp->rrepr,rp->rsize);
- for(j=0;j<MAXMEMBERS;j++)
- if(rp->rmembers[j] != 0)
- printf(", %s",machregs[rp->rmembers[j]]->rname);
- printf(")");
- for(j=0;j<nprops;j++)
- if(rp->rprop[j>>4]&(1<<(j&017)))
- printf(", %s",machprops[j].propname->i_name);
- printf(".\n");
- }
-}
-
-out(n) {
-
- assert(n>=0);
- if (n<128)
- outbyte(n);
- else {
- outbyte(n/256+128);
- outbyte(n%256);
- }
-}
-
-outbyte(n) {
-
- fprintf(cfile,"%d, ",n&BMASK);
- codebytes++;
-}
-
-pat(n) {
-
- assert(n>=0);
- if (n<128)
- patbyte(n);
- else {
- patbyte(n/256+128);
- patbyte(n%256);
- }
-}
-
-patshort(n) {
-
- patbyte(n&BMASK);
- patbyte(n>>BSHIFT);
-}
-
-patbyte(n) {
-
- chktabsiz(npatbytes,MAXPATTERN,"Pattern table");
- pattern[npatbytes++] = n;
-}
-
-max(a,b) {
-
- if (a>b)
- return(a);
- return(b);
-}
-
-#include "bootlex.c"
+++ /dev/null
-%{
-
-#ifndef NORCSID
-static char rcsid2[]="$Header$";
-#endif
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#undef input
-#undef output
-#undef unput
-
-#define MAXBACKUP 50
-%}
-%%
-"/*" { char c;
- c = input();
- do {
- while (c!='*')
- c = input();
- c = input();
- } while (c!='/');
- }
-"REGISTERS:" return(REGISTERHEAD);
-"TOKENS:" return(TOKENHEAD);
-"TOKENEXPRESSIONS:" return(EXPRESSIONHEAD);
-"CODE:" return(CODEHEAD);
-"MOVES:" return(MOVEHEAD);
-"TESTS:" return(TESTHEAD);
-"STACKS:" return(STACKHEAD);
-"SIZEFACTOR" return(SIZEFAC);
-"TIMEFACTOR" return(TIMEFAC);
-"FORMAT" return(FORMAT);
-
-"cost" return(COST);
-"remove" return(REMOVE);
-"|" return(SEP);
-"samesign" return(SAMESIGN);
-"inreg" return(INREG);
-"sfit" return(SFIT);
-"ufit" return(UFIT);
-"defined" return(DEFINED);
-"rom" return(ROM);
-"loww" return(LOWW);
-"highw" return(HIGHW);
-"move" return(MOVE);
-"erase" return(ERASE);
-"allocate" return(ALLOCATE);
-"tostring" return(TOSTRING);
-"nocc" return(NOCC);
-"setcc" return(SETCC);
-"samecc" return(SAMECC);
-"test" return(TEST);
-"STACK" return(STACK);
-"nocoercions" return(NOCOERC);
-
-"&&" return(AND2);
-"||" return(OR2);
-"==" return(CMPEQ);
-"!=" return(CMPNE);
-"<=" return(CMPLE);
-"<" return(CMPLT);
-">" return(CMPGT);
-">=" return(CMPGE);
-">>" return(RSHIFT);
-"<<" return(LSHIFT);
-"!" return(NOT);
-"~" return(COMP);
-"..." return(ELLIPS);
-
-EM_WSIZE { yylval.yy_intp = &wsize; return(CIDENT); }
-EM_PSIZE { yylval.yy_intp = &psize; return(CIDENT); }
-EM_BSIZE { yylval.yy_intp = &bsize; return(CIDENT); }
-REGISTER { yylval.yy_string = "REGISTER"; return(TYPENAME); }
-INT { yylval.yy_string = "INT"; return(TYPENAME); }
-STRING { yylval.yy_string = "STRING"; return(TYPENAME); }
-
-regvar return(REGVAR);
-loop return(LOOP);
-pointer return(POINTER);
-float return(FLOAT);
-return return(RETURN);
-
-[_A-Za-z][_A-Za-z0-9]+ {register ident_p ip;
- if(!lookident || (ip=ilookup(yytext,JUSTLOOKING))==0) {
- yylval.yy_string = scopy(yytext);return(IDENT);
- } else {
- yylval.yy_ident = ip;
- switch(ip->i_type) {
- default:assert(0);
- case IREG:return(RIDENT);
- case IPRP:return(PIDENT);
- case ITOK:return(TIDENT);
- case IEXP:return(EIDENT);
- }
- }
- }
-[a-z] {yylval.yy_char = yytext[0]; return(LCASELETTER);}
-[0-9]* {yylval.yy_int = atoi(yytext);return(NUMBER);}
-(\"|"%)") { char *p; int c,tipe;
- p=yytext;
- for (;;) {
- c = input();
- switch(c) {
- default: *p++=c;break;
- case '\\':
- *p++=c; *p++=input(); break;
- case '\n':
- yyerror("Unterminated string");
- break;
- case '"':
- tipe=STRING; goto endstr;
- case '%':
- c=input();
- if (c == '(') {
- tipe=LSTRING;goto endstr;
- } else {
- *p++ = '%'; unput(c); break;
- }
- }
- }
- endstr:
- *p++ = 0;
- yylval.yy_string = scopy(yytext);
- return(tipe);
- }
-[ \t]* |
-\n ;
-. return(yytext[0]);
-%%
-
-char linebuf[256];
-char prevbuf[256];
-int linep;
-int linepos; /* corrected for tabs */
-char charstack[MAXBACKUP];
-int nbackup=0;
-
-output(c) {
-
- assert(0);
-}
-
-input() {
-
- if(nbackup)
- return(charstack[--nbackup]);
- if(linebuf[linep]==0) {
- strcpy(prevbuf,linebuf);
- if(fgets(linebuf,256,stdin)==NULL)
- return(0);
- lino++;
- linepos=linep=0;
- }
- if (linebuf[linep] == '\t')
- linepos = (linepos+8) & ~07;
- else linepos++;
- return(linebuf[linep++]);
-}
-
-unput(c) {
-
- chktabsiz(nbackup,MAXBACKUP,"Lexical backup table");
- charstack[nbackup++] = c;
-}
-
-yyerror(s,a1,a2,a3,a4) string s; {
-
- fprintf(stderr,"%d\t%s%d\t%s\t%*c ",lino-1,prevbuf,lino,linebuf,
- linepos-1,'^');
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
- nerrors++;
-}
+++ /dev/null
-# $Header$
-
-CFILES=main.c getline.c lookup.c var.c process.c backward.c util.c\
- alloc.c putline.c cleanup.c peephole.c flow.c reg.c
-OFILES=main.o getline.o lookup.o var.o process.o backward.o util.o\
- alloc.o putline.o cleanup.o peephole.o flow.o reg.o
-KFILES=main.k getline.k lookup.k var.k process.k backward.k util.k\
- alloc.k putline.k cleanup.k peephole.k flow.k reg.k
-LIBS=../../lib/em_data.a
-CFLAGS=-O -DNDEBUG
-LDFLAGS=-i
-LINT=lint
-OPR=wide|opr
-XREF=xref -c -w80
-PROPTS=
-# LEXLIB is implementation dependent, try -ll or -lln first
-LEXLIB=-ll
-
-.DEFAULT:
- co -q $<
-
-opt: $(OFILES) pattern.o $(LIBS)
- cc $(LDFLAGS) $(CFLAGS) $(OFILES) pattern.o $(LIBS) -o opt
-
-test: opt testopt
- testopt
-
-cmp : opt
- cmp opt ../../lib/em_opt
-
-install:opt
- size opt ../../lib/em_opt
- cp opt ../../lib/em_opt
-
-pattern.c: patterns mktab
- /lib/cpp patterns | mktab > pattern.c
-
-mktab: mktab.o $(LIBS)
- cc $(CFLAGS) mktab.o $(LIBS) $(LEXLIB) -o mktab
-
-depend: makedepend
- makedepend
-
-lint: $(CFILES) pattern.c
- $(LINT) $(CFILES) pattern.c>lint 2>&1
-
-printall:
- -pr $(PROPTS) Makefile -n *.h `ls $(CFILES)` mktab.y scan.l patterns|$(OPR)
- touch print
-
-print: Makefile *.h $(CFILES) mktab.y scan.l patterns
- -pr $(PROPTS) -n $? | $(OPR)
-
-opr:
- make pr ^ $(OPR)
-
-pr:
- @pr $(PROPTS) -n Makefile *.h $(CFILES) mktab.y scan.l patterns
-
-xref:
- $(XREF) *.h $(CFILES) | pr $(PROPTS) -h "XREF EMOPT"|$(OPR)&
-
-sizes: opt
- -nm opt | sort -n| /usr/plain/bin/map
-
-clean:
- rm -f *.o opt mktab mktab.c scan.c pattern.c
-
-kfiles: $(KFILES)
-
-.SUFFIXES: .k
-.c.k: ; cem -c $*.c
-
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-alloc.o: alloc.h
-alloc.o: assert.h
-alloc.o: line.h
-alloc.o: lookup.h
-alloc.o: param.h
-alloc.o: proinf.h
-alloc.o: types.h
-backward.o: ../../h/em_mnem.h
-backward.o: ../../h/em_pseu.h
-backward.o: ../../h/em_spec.h
-backward.o: alloc.h
-backward.o: assert.h
-backward.o: ext.h
-backward.o: line.h
-backward.o: lookup.h
-backward.o: param.h
-backward.o: proinf.h
-backward.o: types.h
-cleanup.o: ../../h/em_mes.h
-cleanup.o: ../../h/em_pseu.h
-cleanup.o: ../../h/em_spec.h
-cleanup.o: assert.h
-cleanup.o: ext.h
-cleanup.o: lookup.h
-cleanup.o: param.h
-cleanup.o: types.h
-flow.o: ../../h/em_flag.h
-flow.o: ../../h/em_mnem.h
-flow.o: ../../h/em_spec.h
-flow.o: alloc.h
-flow.o: ext.h
-flow.o: line.h
-flow.o: optim.h
-flow.o: param.h
-flow.o: proinf.h
-flow.o: types.h
-getline.o: ../../h/em_flag.h
-getline.o: ../../h/em_mes.h
-getline.o: ../../h/em_pseu.h
-getline.o: ../../h/em_spec.h
-getline.o: alloc.h
-getline.o: assert.h
-getline.o: ext.h
-getline.o: line.h
-getline.o: lookup.h
-getline.o: param.h
-getline.o: proinf.h
-getline.o: types.h
-lookup.o: alloc.h
-lookup.o: lookup.h
-lookup.o: param.h
-lookup.o: proinf.h
-lookup.o: types.h
-main.o: ../../h/em_spec.h
-main.o: alloc.h
-main.o: ext.h
-main.o: param.h
-main.o: types.h
-mktab.o: ../../h/em_mnem.h
-mktab.o: ../../h/em_spec.h
-mktab.o: optim.h
-mktab.o: param.h
-mktab.o: pattern.h
-mktab.o: scan.c
-mktab.o: types.h
-pattern.o: param.h
-pattern.o: pattern.h
-pattern.o: types.h
-peephole.o: ../../h/em_mnem.h
-peephole.o: ../../h/em_spec.h
-peephole.o: alloc.h
-peephole.o: assert.h
-peephole.o: ext.h
-peephole.o: line.h
-peephole.o: lookup.h
-peephole.o: optim.h
-peephole.o: param.h
-peephole.o: pattern.h
-peephole.o: proinf.h
-peephole.o: types.h
-process.o: ../../h/em_pseu.h
-process.o: ../../h/em_spec.h
-process.o: alloc.h
-process.o: assert.h
-process.o: ext.h
-process.o: line.h
-process.o: lookup.h
-process.o: param.h
-process.o: proinf.h
-process.o: types.h
-putline.o: ../../h/em_flag.h
-putline.o: ../../h/em_mnem.h
-putline.o: ../../h/em_pseu.h
-putline.o: ../../h/em_spec.h
-putline.o: alloc.h
-putline.o: assert.h
-putline.o: ext.h
-putline.o: line.h
-putline.o: lookup.h
-putline.o: optim.h
-putline.o: param.h
-putline.o: proinf.h
-putline.o: types.h
-reg.o: ../../h/em_mes.h
-reg.o: ../../h/em_pseu.h
-reg.o: ../../h/em_spec.h
-reg.o: alloc.h
-reg.o: assert.h
-reg.o: ext.h
-reg.o: line.h
-reg.o: param.h
-reg.o: proinf.h
-reg.o: types.h
-scan.o: stdio.h
-special.o: param.h
-special.o: types.h
-util.o: assert.h
-util.o: ext.h
-util.o: lookup.h
-util.o: optim.h
-util.o: param.h
-util.o: proinf.h
-util.o: types.h
-var.o: lookup.h
-var.o: param.h
-var.o: proinf.h
-var.o: types.h
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "alloc.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#ifdef USEMALLOC
-
-short * myalloc();
-
-#define newcore(size) myalloc(size)
-#define oldcore(p,size) free(p)
-
-#else
-
-/* #define CORECHECK /* if defined tests are made to insure
- each block occurs at most once */
-
-#define CCHUNK 1024 /* number of shorts asked from system */
-
-short *newcore(),*freshcore();
-extern char *sbrk();
-
-#ifdef COREDEBUG
-int shortsasked=0;
-#endif
-
-#endif
-
-/*
- * The following two sizetables contain the sizes of the various kinds
- * of line and argument structures.
- * Care has been taken to make this table implementation independent,
- * but if you think very hard you might find a compiler failing the
- * assumptions made.
- * A wasteful but safe approach is to replace every line of them by
- * sizeof(line_t)
- * and
- * sizeof(arg_t)
- * respectively.
- */
-
-#define LBASE (sizeof(line_t)-sizeof(un_l_a))
-
-int lsizetab[] = {
- LBASE,
- LBASE+sizeof(short),
- LBASE+sizeof(offset),
- LBASE+sizeof(num_p),
- LBASE+sizeof(sym_p),
- LBASE+sizeof(s_la_sval),
- LBASE+sizeof(s_la_lval),
- LBASE+sizeof(arg_p),
- LBASE
-};
-
-#define ABASE (sizeof(arg_t)-sizeof(un_a_a))
-
-int asizetab[] = {
- ABASE+sizeof(offset),
- ABASE+sizeof(num_p),
- ABASE+sizeof(sym_p),
- ABASE+sizeof(s_a_val),
- ABASE+sizeof(argb_t),
- ABASE+sizeof(s_a_con),
- ABASE+sizeof(s_a_con),
- ABASE+sizeof(s_a_con),
-};
-
-/*
- * alloc routines:
- * Two parts:
- * 1) typed alloc and free routines
- * 2) untyped raw core allocation
- */
-
-/*
- * PART 1
- */
-
-line_p newline(optyp) int optyp; {
- register line_p lnp;
- register kind=optyp;
-
- if (kind>OPMINI)
- kind = OPMINI;
- lnp = (line_p) newcore(lsizetab[kind]);
- lnp->l_optyp = optyp;
- return(lnp);
-}
-
-oldline(lnp) register line_p lnp; {
- register kind=lnp->l_optyp&BMASK;
-
- if (kind>OPMINI)
- kind = OPMINI;
- if (kind == OPLIST)
- oldargs(lnp->l_a.la_arg);
- oldcore((short *) lnp,lsizetab[kind]);
-}
-
-arg_p newarg(kind) int kind; {
- register arg_p ap;
-
- ap = (arg_p) newcore(asizetab[kind]);
- ap->a_typ = kind;
- return(ap);
-}
-
-oldargs(ap) register arg_p ap; {
- register arg_p next;
-
- while (ap != (arg_p) 0) {
- next = ap->a_next;
- switch(ap->a_typ) {
- case ARGSTR:
- oldargb(ap->a_a.a_string.ab_next);
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- oldargb(ap->a_a.a_con.ac_con.ab_next);
- break;
- }
- oldcore((short *) ap,asizetab[ap->a_typ]);
- ap = next;
- }
-}
-
-oldargb(abp) register argb_p abp; {
- register argb_p next;
-
- while (abp != (argb_p) 0) {
- next = abp->ab_next;
- oldcore((short *) abp,sizeof (argb_t));
- abp = next;
- }
-}
-
-reg_p newreg() {
-
- return((reg_p) newcore(sizeof(reg_t)));
-}
-
-oldreg(rp) reg_p rp; {
-
- oldcore((short *) rp,sizeof(reg_t));
-}
-
-num_p newnum() {
-
- return((num_p) newcore(sizeof(num_t)));
-}
-
-oldnum(lp) num_p lp; {
-
- oldcore((short *) lp,sizeof(num_t));
-}
-
-offset *newrom() {
-
- return((offset *) newcore(MAXROM*sizeof(offset)));
-}
-
-sym_p newsym(len) int len; {
- /*
- * sym_t includes a 2 character s_name at the end
- * extend this structure with len-2 characters
- */
- return((sym_p) newcore(sizeof(sym_t) - 2 + len));
-}
-
-argb_p newargb() {
-
- return((argb_p) newcore(sizeof(argb_t)));
-}
-
-#ifndef USEMALLOC
-
-/******************************************************************/
-/****** Start of raw core management package *****************/
-/******************************************************************/
-
-#define MAXSHORT 30 /* Maximum number of shorts one can ask for */
-
-short *freelist[MAXSHORT];
-
-typedef struct coreblock {
- struct coreblock *co_next;
- short co_size;
-} core_t,*core_p;
-
-#define SINC (sizeof(core_t)/sizeof(short))
-#ifdef COREDEBUG
-coreverbose() {
- register size;
- register short *p;
- register sum;
-
- sum = 0;
- for(size=1;size<MAXSHORT;size++)
- for (p=freelist[size];p!=0;p = *(short **) p)
- sum += size;
- fprintf(stderr,"Used core %u\n",(shortsasked-sum)*sizeof(short));
-}
-#endif
-
-#ifdef SEPID
-
-compactcore() {
- register core_p corelist=0,tp,cl;
- int size;
-
-#ifdef COREDEBUG
- fprintf(stderr,"Almost out of core\n");
-#endif
- for(size=SINC;size<MAXSHORT;size++) {
- while ((tp = (core_p) freelist[size]) != (core_p) 0) {
- freelist[size] = (short *) tp->co_next;
- tp->co_size = size;
- if (corelist==0 || tp<corelist) {
- tp->co_next = corelist;
- corelist = tp;
- } else {
- for(cl=corelist;cl->co_next != 0 && tp>cl->co_next;
- cl = cl->co_next)
- ;
- tp->co_next = cl->co_next;
- cl->co_next = tp;
- }
- }
- }
- while (corelist != 0) {
- while ((short *) corelist->co_next ==
- (short *) corelist + corelist->co_size) {
- corelist->co_size += corelist->co_next->co_size;
- corelist->co_next = corelist->co_next->co_next;
- }
- assert(corelist->co_next==0 ||
- (short *) corelist->co_next >
- (short *) corelist + corelist->co_size);
- while (corelist->co_size >= MAXSHORT+SINC) {
- oldcore((short *) corelist + corelist->co_size-(MAXSHORT-1),
- sizeof(short)*(MAXSHORT-1));
- corelist->co_size -= MAXSHORT;
- }
- if (corelist->co_size >= MAXSHORT) {
- oldcore((short *) corelist + corelist->co_size-SINC,
- sizeof(short)*SINC);
- corelist->co_size -= SINC;
- }
- cl = corelist->co_next;
- oldcore((short *) corelist, sizeof(short)*corelist->co_size);
- corelist = cl;
- }
-}
-
-short *grabcore(size) int size; {
- register short *p;
- register trysize;
-
- /*
- * Desperate situation, can't get more core from system.
- * Postpone giving up just a little bit by splitting up
- * larger free blocks if possible.
- * Algorithm is worst fit.
- */
-
- assert(size<2*MAXSHORT);
- for(trysize=2*MAXSHORT-2; trysize>size; trysize -= 2) {
- p = freelist[trysize/sizeof(short)];
- if ( p != (short *) 0) {
- freelist[trysize/sizeof(short)] = *(short **) p;
- oldcore(p+size/sizeof(short),trysize-size);
- return(p);
- }
- }
-
- /*
- * Can't get more core from the biggies, try to combine the
- * little ones. This is expensive but probably better than
- * giving up.
- */
-
- compactcore();
- if ((p=freelist[size/sizeof(short)]) != 0) {
- freelist[size/sizeof(short)] = * (short **) p;
- return(p);
- }
- for(trysize=2*MAXSHORT-2; trysize>size; trysize -= 2) {
- p = freelist[trysize/sizeof(short)];
- if ( p != (short *) 0) {
- freelist[trysize/sizeof(short)] = *(short **) p;
- oldcore(p+size/sizeof(short),trysize-size);
- return(p);
- }
- }
-
- /*
- * That's it then. Finished.
- */
-
- return(0);
-}
-#endif /* SEPID */
-
-short *newcore(size) int size; {
- register short *p,*q;
-
- if( size < 2*MAXSHORT ) {
- if ((p=freelist[size/sizeof(short)]) != (short *) 0)
- freelist[size/sizeof(short)] = *(short **) p;
- else {
- p = freshcore(size);
-#ifdef SEPID
- if (p == (short *) 0)
- p = grabcore(size);
-#endif
- }
- } else
- p = freshcore(size);
- if (p == 0)
- error("out of memory");
- for (q=p; size > 0 ; size -= sizeof(short))
- *q++ = 0;
- return(p);
-}
-
-#ifdef NOMALLOC
-
-/*
- * stdio uses malloc and free.
- * you can use these as substitutes
- */
-
-char *malloc(size) int size; {
-
- /*
- * malloc(III) is called by stdio,
- * this routine is a substitute.
- */
-
- return( (char *) newcore(size));
-}
-
-free() {
-
-}
-#endif
-
-oldcore(p,size) short *p; int size; {
-#ifdef CORECHECK
- register short *cp;
-#endif
-
- assert(size<2*MAXSHORT);
-#ifdef CORECHECK
- for (cp=freelist[size/sizeof(short)]; cp != (short *) 0;
- cp = (short *) *cp)
- assert(cp != p);
-#endif
- *(short **) p = freelist[size/sizeof(short)];
- freelist[size/sizeof(short)] = p;
-}
-
-short *ccur,*cend;
-
-coreinit(p1,p2) short *p1,*p2; {
-
- /*
- * coreinit is called with the boundaries of a piece of
- * memory that can be used for starters.
- */
-
- ccur = p1;
- cend = p2;
-}
-
-short *freshcore(size) int size; {
- register short *temp;
- static int cchunk=CCHUNK;
-
- while(&ccur[size/sizeof(short)] >= cend && cchunk>0) {
- do {
- temp = (short *) sbrk(cchunk*sizeof(short));
- if (temp == (short *) -1)
- cchunk >>= 1;
- else if (temp != cend)
- ccur = cend = temp;
- } while (temp == (short *) -1 && cchunk>0);
- cend += cchunk;
-#ifdef COREDEBUG
- shortsasked += cchunk;
-#endif
- }
- if (cchunk==0)
- return(0);
- temp = ccur;
- ccur = &ccur[size/sizeof(short)];
- return(temp);
-}
-
-#else /* USEMALLOC */
-
-coreinit() {
-
- /*
- * Empty function, no initialization needed
- */
-}
-
-short *myalloc(size) register size; {
- register short *p,*q;
- extern char *malloc();
-
- p = (short *)malloc(size);
- if (p == 0)
- error("out of memory");
- for(q=p;size>0;size -= sizeof(short))
- *q++ = 0;
- return(p);
-}
-#endif
+++ /dev/null
-/* $Header$ */
-
-extern line_p newline();
-extern offset *newrom();
-extern sym_p newsym();
-extern num_p newnum();
-extern arg_p newarg();
-extern argb_p newargb();
-extern reg_p newreg();
-
-extern oldline();
-extern oldloc();
-extern oldreg();
-
-/* #define USEMALLOC /* if defined malloc() and free() are used */
-
-/* #define COREDEBUG /* keep records and print statistics */
-
-/*
- * The next define gives if defined the number of pseudo's outside
- * procedures that are collected without processing.
- * If undefined all pseudo's will be collected but that may
- * give trouble on small machines, because of lack of room.
- */
-#define PSEUBETWEEN 200
-
-#ifndef USEMALLOC
-/*
- * Now the real bitsqueezing starts.
- * When running on a machine where code and data live in
- * separate address-spaces it is worth putting in some extra
- * code to save on probably less data.
- */
-#define SEPID /* code and data in separate spaces */
-/*
- * If the stack segment and the data are separate as on a PDP11 under UNIX
- * it is worth squeezing some shorts out of the stack page.
- */
-#ifndef EM_WSIZE
-/*
- * Compiled with 'standard' C compiler
- */
-#define STACKROOM 3200 /* number of shorts space in stack */
-#else
-/*
- * Compiled with pcc, has trouble with lots of variables
- */
-#define STACKROOM 2000
-#endif
-
-#else
-
-#define STACKROOM 1 /* 0 gives problems */
-
-#endif /* USEMALLOC */
+++ /dev/null
-/* $Header$ */
-
-#ifndef NDEBUG
-#define assert(x) if(!(x)) badassertion(__FILE__,__LINE__)
-#else
-#define assert(x) /* nothing */
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "line.h"
-#include "lookup.h"
-#include "alloc.h"
-#include "proinf.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_mnem.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define local(x) if (((x)->s_flags&SYMKNOWN) == 0)\
- x->s_flags &= ~ SYMGLOBAL
-#define global(x) if(((x)->s_flags&SYMKNOWN) == 0)\
- x->s_flags |= SYMGLOBAL
-
-#define DTYPHOL 1
-#define DTYPBSS 2
-#define DTYPCON 3
-#define DTYPROM 4
-byte curdtyp;
-bool goodrom;
-short curfrag = 3; /* see also peephole.c */
-offset rombuf[MAXROM];
-int rc;
-
-backward() {
- register line_p lnp;
- line_p next;
- register arg_p ap;
- line_p i,p;
- int n;
- register sym_p sp;
-
- i = p = (line_p) 0;
- curdtyp=0;
- for (lnp = curpro.lastline; lnp != (line_p) 0; lnp = next) {
- next = lnp->l_next;
- switch(lnp->l_optyp) {
- case OPSYMBOL:
- global(lnp->l_a.la_sp);
- break;
- case OPSVAL:
- global(lnp->l_a.la_sval.lasv_sp);
- break;
- case OPLVAL:
- global(lnp->l_a.la_lval.lalv_sp);
- break;
- case OPLIST:
- ap = lnp->l_a.la_arg;
- while (ap != (arg_p) 0 ) {
- switch(ap->a_typ) {
- case ARGSYM:
- global(ap->a_a.a_sp);
- break;
- case ARGVAL:
- global(ap->a_a.a_val.av_sp);
- }
- ap = ap->a_next;
- }
- break;
- }
-
- /*
- * references to symbols are processed now.
- * for plain instructions nothing else is needed
- */
-
- switch(lnp->l_instr&BMASK) {
- /*
- * count all local occurences for register counts;
- * op_lal is omitted and not by accident.
- */
- case op_del:
- case op_inl:
- case op_ldl:
- case op_lil:
- case op_lol:
- case op_sdl:
- case op_sil:
- case op_stl:
- case op_zrl:
- switch(lnp->l_optyp) {
- case OPNO:
- case OPNUMLAB:
- case OPSYMBOL:
- case OPSVAL:
- case OPLVAL:
- case OPLIST:
- break;
- case OPOFFSET:
- incregusage(lnp->l_a.la_offset);
- break;
- case OPSHORT:
- incregusage((offset)lnp->l_a.la_short);
- break;
- default:
- incregusage((offset)(lnp->l_optyp&BMASK)-Z_OPMINI);
- break;
- }
- /* fall through !! */
- default:
- assert((lnp->l_instr&BMASK)<=op_last);
- lnp->l_next = i;
- i = lnp;
- continue;
- case ps_sym:
- sp = lnp->l_a.la_sp;
- local(sp);
- if (curdtyp == DTYPROM && goodrom) {
- sp->s_rom = newrom();
- for (n=0;n<rc;n++)
- sp->s_rom[n] = rombuf[n];
- }
- sp->s_frag = curfrag;
- break;
- case ps_hol:
- curdtyp = DTYPHOL;
- curfrag++;
- break;
- case ps_bss:
- curdtyp = DTYPBSS;
- curfrag++;
- break;
- case ps_con:
- if (curdtyp != DTYPCON) {
- curdtyp = DTYPCON;
- curfrag++;
- }
- break;
- case ps_rom:
- if (curdtyp != DTYPROM) {
- curdtyp = DTYPROM;
- curfrag++;
- }
- ap = lnp->l_a.la_arg;
- rc = 0;
- while (ap != (arg_p) 0 && rc < MAXROM) {
- if (ap->a_typ == ARGOFF) {
- rombuf[rc++] = ap->a_a.a_offset;
- ap = ap->a_next;
- } else
- ap = (arg_p) 0;
- }
- goodrom = (rc >= 2);
- break;
- case ps_mes:
- break;
- case ps_inp:
- case ps_ina:
- local(lnp->l_a.la_sp);
- case ps_exp:
- case ps_exa:
- case ps_exc:
- oldline(lnp);
- continue;
- }
- lnp->l_next = p;
- p = lnp;
- }
- if (prodepth != 0)
- local(curpro.symbol);
- instrs = i; pseudos = p; curpro.lastline = (line_p) 0;
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mes.h"
-#include "lookup.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-
-cleanup() {
- FILE *infile;
- register c;
- register sym_p *spp,sp;
-
- for (spp=symhash;spp< &symhash[NSYMHASH];spp++)
- for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
- if ((sp->s_flags & SYMOUT) == 0)
- outdef(sp);
- if(!Lflag)
- return;
- c=fclose(outfile);
- assert(c != EOF);
- outfile = stdout;
- infile = fopen(template,"r");
- if (infile == NULL)
- error("temp file disappeared");
- outshort(sp_magic);
- outinst(ps_mes);
- outint(ms_ext);
- for (spp=symhash;spp< &symhash[NSYMHASH];spp++)
- for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
- if ((sp->s_flags&(SYMDEF|SYMGLOBAL)) == (SYMDEF|SYMGLOBAL))
- outsym(sp);
- putc(sp_cend,outfile);
- while ( (c=getc(infile)) != EOF)
- putc(c,outfile);
- c=fclose(infile);
- assert(c != EOF);
- c=unlink(template);
- assert(c == 0);
-}
+++ /dev/null
-/* $Header$ */
-
-#ifndef FILE
-#include <stdio.h>
-#endif
-extern unsigned linecount;
-extern int prodepth;
-extern bool Lflag;
-extern bool nflag;
-extern byte em_flag[];
-extern line_p instrs,pseudos;
-extern FILE *outfile;
-extern char template[];
-extern offset wordsize;
-extern offset pointersize;
-extern char *progname;
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "../../h/em_flag.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mnem.h"
-#include "alloc.h"
-#include "line.h"
-#include "proinf.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-flow() {
-
- findreach(); /* determine reachable labels */
- cleaninstrs(); /* throw away unreachable code */
-}
-
-findreach() {
- register num_p *npp,np;
-
- reach(instrs);
- for(npp=curpro.numhash;npp< &curpro.numhash[NNUMHASH]; npp++)
- for(np= *npp; np != (num_p) 0 ; np = np->n_next)
- if (np->n_flags&NUMDATA) {
- np->n_repl->n_flags |= NUMREACH;
- np->n_repl->n_jumps++;
- if (!(np->n_flags&NUMSCAN)) {
- np->n_flags |= NUMSCAN;
- reach(np->n_line->l_next);
- }
- }
-}
-
-reach(lnp) register line_p lnp; {
- register num_p np;
-
- for (;lnp != (line_p) 0; lnp = lnp->l_next) {
- if(lnp->l_optyp == OPNUMLAB) {
- /*
- * Branch instruction or label
- */
- np = lnp->l_a.la_np;
- if ((lnp->l_instr&BMASK) != op_lab)
- np = np->n_repl;
- np->n_flags |= NUMREACH;
- if (!(np->n_flags&NUMSCAN)) {
- np->n_flags |= NUMSCAN;
- reach(np->n_line->l_next);
- }
- if ((lnp->l_instr&BMASK) == op_lab)
- return;
- else
- np->n_jumps++;
- }
- if ((em_flag[(lnp->l_instr&BMASK)-sp_fmnem]&EM_FLO)==FLO_T)
- return;
- }
-}
-
-cleaninstrs() {
- register line_p *lpp,lp,*lastbra;
- bool reachable,superfluous;
- int instr;
-
- lpp = &instrs; lastbra = (line_p *) 0; reachable = TRUE;
- while ((lp = *lpp) != (line_p) 0) {
- instr = lp->l_instr&BMASK;
- if (instr == op_lab) {
- if ((lp->l_a.la_np->n_flags&NUMREACH) != 0) {
- reachable = TRUE;
- if (lastbra != (line_p *) 0
- && (*lastbra)->l_next == lp
- && (*lastbra)->l_a.la_np->n_repl==lp->l_a.la_np) {
- oldline(*lastbra);
- OPTIM(O_BRALAB);
- lpp = lastbra;
- *lpp = lp;
- lp->l_a.la_np->n_jumps--;
- }
- }
- if ( lp->l_a.la_np->n_repl != lp->l_a.la_np ||
- ((lp->l_a.la_np->n_flags&NUMDATA)==0 &&
- lp->l_a.la_np->n_jumps == 0))
- superfluous = TRUE;
- else
- superfluous = FALSE;
- } else
- superfluous = FALSE;
- if ( (!reachable) || superfluous) {
- lp = lp->l_next;
- oldline(*lpp);
- OPTIM(O_UNREACH);
- *lpp = lp;
- } else {
- if ( instr <= sp_lmnem &&
- (em_flag[instr-sp_fmnem]&EM_FLO)==FLO_T) {
- reachable = FALSE;
- if ((lp->l_instr&BMASK) == op_bra)
- lastbra = lpp;
- }
- lpp = &lp->l_next;
- }
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "line.h"
-#include "lookup.h"
-#include "alloc.h"
-#include "proinf.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_flag.h"
-#include "../../h/em_mes.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-
-static short tabval; /* temp store for shorts */
-static offset tabval2; /* temp store for offsets */
-static char string[IDL+1]; /* temp store for names */
-
-/*
- * The next constants are close to sp_cend for fast switches
- */
-#define INST 256 /* instruction: number in tabval */
-#define PSEU 257 /* pseudo: number in tabval */
-#define ILBX 258 /* label: number in tabval */
-#define DLBX 259 /* symbol: name in string[] */
-#define CSTX1 260 /* short constant: stored in tabval */
-#define CSTX2 261 /* offset: value in tabval2 */
-#define VALX1 262 /* symbol+short: in string[] and tabval */
-#define VALX2 263 /* symbol+offset: in string[] and tabval2 */
-#define ATEOF 264 /* bumped into end of file */
-
-#define readbyte getchar
-
-short readshort() {
- register int l_byte, h_byte;
-
- l_byte = readbyte();
- h_byte = readbyte();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-#ifdef LONGOFF
-offset readoffset() {
- register long l;
- register int h_byte;
-
- l = readbyte();
- l |= ((unsigned) readbyte())*256 ;
- l |= readbyte()*256L*256L ;
- h_byte = readbyte() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-#endif
-
-draininput() {
-
- /*
- * called when MES ERR is encountered.
- * Drain input in case it is a pipe.
- */
-
- while (getchar() != EOF)
- ;
-}
-
-short getint() {
-
- switch(table2()) {
- default: error("int expected");
- case CSTX1:
- return(tabval);
- }
-}
-
-sym_p getsym(status) int status; {
-
- switch(table2()) {
- default:
- error("symbol expected");
- case DLBX:
- return(symlookup(string,status,0));
- case sp_pnam:
- return(symlookup(string,status,SYMPRO));
- }
-}
-
-offset getoff() {
-
- switch (table2()) {
- default: error("offset expected");
- case CSTX1:
- return((offset) tabval);
-#ifdef LONGOFF
- case CSTX2:
- return(tabval2);
-#endif
- }
-}
-
-make_string(n) int n; {
- register char *s;
- extern char *sprintf();
-
- s=sprintf(string,".%u",n);
- assert(s == string);
-}
-
-inident() {
- register n;
- register char *p = string;
- register c;
-
- n = getint();
- while (n--) {
- c = readbyte();
- if (p<&string[IDL])
- *p++ = c;
- }
- *p++ = 0;
-}
-
-int table3(n) int n; {
-
- switch (n) {
- case sp_ilb1: tabval = readbyte(); return(ILBX);
- case sp_ilb2: tabval = readshort(); return(ILBX);
- case sp_dlb1: make_string(readbyte()); return(DLBX);
- case sp_dlb2: make_string(readshort()); return(DLBX);
- case sp_dnam: inident(); return(DLBX);
- case sp_pnam: inident(); return(n);
- case sp_cst2: tabval = readshort(); return(CSTX1);
-#ifdef LONGOFF
- case sp_cst4: tabval2 = readoffset(); return(CSTX2);
-#endif
- case sp_doff: if (table2()!=DLBX) error("symbol expected");
- switch(table2()) {
- default: error("offset expected");
- case CSTX1: return(VALX1);
-#ifdef LONGOFF
- case CSTX2: return(VALX2);
-#endif
- }
- default: return(n);
- }
-}
-
-int table1() {
- register n;
-
- n = readbyte();
- if (n == EOF)
- return(ATEOF);
- if ((n <= sp_lmnem) && (n >= sp_fmnem)) {
- tabval = n;
- return(INST);
- }
- if ((n <= sp_lpseu) && (n >= sp_fpseu)) {
- tabval = n;
- return(PSEU);
- }
- if ((n < sp_filb0 + sp_nilb0) && (n >= sp_filb0)) {
- tabval = n - sp_filb0;
- return(ILBX);
- }
- return(table3(n));
-}
-
-int table2() {
- register n;
-
- n = readbyte();
- if ((n < sp_fcst0 + sp_ncst0) && (n >= sp_fcst0)) {
- tabval = n - sp_zcst0;
- return(CSTX1);
- }
- return(table3(n));
-}
-
-getlines() {
- register line_p lnp;
- register instr;
-
- for(;;) {
- linecount++;
- switch(table1()) {
- default:
- error("unknown instruction byte");
- /* NOTREACHED */
-
- case ATEOF:
- if (prodepth!=0)
- error("procedure unterminated at eof");
- process();
- return;
- case INST:
- tstinpro();
- instr = tabval;
- break;
- case DLBX:
- lnp = newline(OPSYMBOL);
- lnp->l_instr = ps_sym;
- lnp->l_a.la_sp= symlookup(string,DEFINING,0);
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- continue;
- case ILBX:
- tstinpro();
- lnp = newline(OPNUMLAB);
- lnp->l_instr = op_lab;
- lnp->l_a.la_np = numlookup((unsigned) tabval);
- if (lnp->l_a.la_np->n_line != (line_p) 0)
- error("label %u multiple defined",(unsigned) tabval);
- lnp->l_a.la_np->n_line = lnp;
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- continue;
- case PSEU:
- if(inpseudo(tabval))
- return;
- continue;
- }
-
- /*
- * Now we have an instruction number in instr
- * There might be an operand, look for it
- */
-
- if ((em_flag[instr-sp_fmnem]&EM_PAR)==PAR_NO) {
- lnp = newline(OPNO);
- } else switch(table2()) {
- default:
- error("unknown offset byte");
- case sp_cend:
- lnp = newline(OPNO);
- break;
- case CSTX1:
- if ((em_flag[instr-sp_fmnem]&EM_PAR)!= PAR_B) {
- if (CANMINI(tabval))
- lnp = newline(tabval+Z_OPMINI);
- else {
- lnp = newline(OPSHORT);
- lnp->l_a.la_short = tabval;
- }
- } else {
- lnp = newline(OPNUMLAB);
- lnp->l_a.la_np = numlookup((unsigned) tabval);
- }
- break;
-#ifdef LONGOFF
- case CSTX2:
- lnp = newline(OPOFFSET);
- lnp->l_a.la_offset = tabval2;
- break;
-#endif
- case ILBX:
- tstinpro();
- lnp = newline(OPNUMLAB);
- lnp->l_a.la_np = numlookup((unsigned) tabval);
- break;
- case DLBX:
- lnp = newline(OPSYMBOL);
- lnp->l_a.la_sp = symlookup(string,OCCURRING,0);
- break;
- case sp_pnam:
- lnp = newline(OPSYMBOL);
- lnp->l_a.la_sp = symlookup(string,OCCURRING,SYMPRO);
- break;
- case VALX1:
- lnp = newline(OPSVAL);
- lnp->l_a.la_sval.lasv_sp = symlookup(string,OCCURRING,0);
- lnp->l_a.la_sval.lasv_short = tabval;
- break;
-#ifdef LONGOFF
- case VALX2:
- lnp = newline(OPLVAL);
- lnp->l_a.la_lval.lalv_sp = symlookup(string,OCCURRING,0);
- lnp->l_a.la_lval.lalv_offset = tabval2;
- break;
-#endif
- }
- lnp->l_instr = instr;
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- }
-}
-
-argstring(length,abp) offset length; register argb_p abp; {
-
- while (length--) {
- if (abp->ab_index == NARGBYTES)
- abp = abp->ab_next = newargb();
- abp->ab_contents[abp->ab_index++] = readbyte();
- }
-}
-
-line_p arglist(n) int n; {
- line_p lnp;
- register arg_p ap,*app;
- bool moretocome;
- offset length;
-
-
- /*
- * creates an arglist with n elements
- * if n == 0 the arglist is variable and terminated by sp_cend
- */
-
- lnp = newline(OPLIST);
- app = &lnp->l_a.la_arg;
- moretocome = TRUE;
- do {
- switch(table2()) {
- default:
- error("unknown byte in arglist");
- case CSTX1:
- tabval2 = (offset) tabval;
- case CSTX2:
- *app = ap = newarg(ARGOFF);
- ap->a_a.a_offset = tabval2;
- app = &ap->a_next;
- break;
- case ILBX:
- tstinpro();
- *app = ap = newarg(ARGNUM);
- ap->a_a.a_np = numlookup((unsigned) tabval);
- ap->a_a.a_np->n_flags |= NUMDATA;
- app = &ap->a_next;
- break;
- case DLBX:
- *app = ap = newarg(ARGSYM);
- ap->a_a.a_sp = symlookup(string,OCCURRING,0);
- app = &ap->a_next;
- break;
- case sp_pnam:
- *app = ap = newarg(ARGSYM);
- ap->a_a.a_sp = symlookup(string,OCCURRING,SYMPRO);
- app = &ap->a_next;
- break;
- case VALX1:
- tabval2 = (offset) tabval;
- case VALX2:
- *app = ap = newarg(ARGVAL);
- ap->a_a.a_val.av_sp = symlookup(string,OCCURRING,0);
- ap->a_a.a_val.av_offset = tabval2;
- app = &ap->a_next;
- break;
- case sp_scon:
- *app = ap = newarg(ARGSTR);
- length = getoff();
- argstring(length,&ap->a_a.a_string);
- app = &ap->a_next;
- break;
- case sp_icon:
- *app = ap = newarg(ARGICN);
- goto casecon;
- case sp_ucon:
- *app = ap = newarg(ARGUCN);
- goto casecon;
- case sp_fcon:
- *app = ap = newarg(ARGFCN);
- casecon:
- length = getint();
- ap->a_a.a_con.ac_length = (short) length;
- argstring(getoff(),&ap->a_a.a_con.ac_con);
- app = &ap->a_next;
- break;
- case sp_cend:
- moretocome = FALSE;
- }
- if (n && (--n) == 0)
- moretocome = FALSE;
- } while (moretocome);
- return(lnp);
-}
-
-offset aoff(ap,n) register arg_p ap; {
-
- while (n>0) {
- if (ap != (arg_p) 0)
- ap = ap->a_next;
- n--;
- }
- if (ap == (arg_p) 0)
- error("too few parameters");
- if (ap->a_typ != ARGOFF)
- error("offset expected");
- return(ap->a_a.a_offset);
-}
-
-int inpseudo(n) short n; {
- register line_p lnp,head,tail;
- short n1,n2;
- proinf savearea;
-#ifdef PSEUBETWEEN
- static int pcount=0;
-
- if (pcount++ >= PSEUBETWEEN && prodepth==0) {
- process();
- pcount=0;
- }
-#endif
-
- switch(n) {
- default:
- error("unknown pseudo");
- case ps_bss:
- case ps_hol:
- lnp = arglist(3);
- break;
- case ps_rom:
- case ps_con:
- lnp = arglist(0);
- break;
- case ps_ina:
- case ps_inp:
- case ps_exa:
- case ps_exp:
- lnp = newline(OPSYMBOL);
- lnp->l_a.la_sp = getsym(NOTHING);
- break;
- case ps_exc:
- n1 = getint(); n2 = getint();
- if (n1 != 0 && n2 != 0) {
- tail = curpro.lastline;
- while (--n2) tail = tail->l_next;
- head = tail;
- while (n1--) head = head->l_next;
- lnp = tail->l_next;
- tail->l_next = head->l_next;
- head->l_next = curpro.lastline;
- curpro.lastline = lnp;
- }
- lnp = newline(OPNO);
- break;
- case ps_mes:
- lnp = arglist(0);
- switch((int) aoff(lnp->l_a.la_arg,0)) {
- case ms_err:
- draininput(); exit(-1);
- case ms_opt:
- nflag = TRUE; break;
- case ms_emx:
- wordsize = aoff(lnp->l_a.la_arg,1);
- pointersize = aoff(lnp->l_a.la_arg,2);
-#ifndef LONGOFF
- if (wordsize>2)
- error("This optimizer cannot handle wordsize>2");
-#endif
- break;
- case ms_gto:
- curpro.gtoproc=1;
- /* Treat as empty mes ms_reg */
- case ms_reg:
- tstinpro();
- regvar(lnp->l_a.la_arg->a_next);
- oldline(lnp);
- lnp=newline(OPNO);
- n=ps_exc; /* kludge to force out this line */
- break;
- }
- break;
- case ps_pro:
- if (prodepth>0)
- savearea = curpro;
- else
- process();
- curpro.symbol = getsym(DEFINING);
- switch(table2()) {
- case sp_cend:
- curpro.localbytes = (offset) -1;
- break;
- case CSTX1:
- tabval2 = (offset) tabval;
- case CSTX2:
- curpro.localbytes = tabval2;
- break;
- default:
- error("bad second arg of PRO");
- }
- prodepth++;
- curpro.gtoproc=0;
- if (prodepth>1) {
- register i;
-
- curpro.lastline = (line_p) 0;
- curpro.freg = (reg_p) 0;
- for(i=0;i<NNUMHASH;i++)
- curpro.numhash[i] = (num_p) 0;
- getlines();
- curpro = savearea;
- prodepth--;
- }
- return(0);
- case ps_end:
- if (prodepth==0)
- error("END misplaced");
- switch(table2()) {
- case sp_cend:
- if (curpro.localbytes == (offset) -1)
- error("bytes for locals still unknown");
- break;
- case CSTX1:
- tabval2 = (offset) tabval;
- case CSTX2:
- if (curpro.localbytes != (offset) -1 && curpro.localbytes != tabval2)
- error("inconsistency in number of bytes for locals");
- curpro.localbytes = tabval2;
- break;
- }
- process();
- curpro.symbol = (sym_p) 0;
- if (prodepth==1) {
- prodepth=0;
-#ifdef PSEUBETWEEN
- pcount=0;
-#endif
- return(0);
- } else
- return(1);
- }
- lnp->l_instr = n;
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- return(0);
-}
-
-tstinpro() {
-
- if (prodepth==0)
- error("This is not allowed outside a procedure");
-}
+++ /dev/null
-/* $Header$ */
-
-#define NARGBYTES 14
-struct argbytes {
- argb_p ab_next;
- short ab_index;
- char ab_contents[NARGBYTES];
-};
-
-typedef struct {
- sym_p av_sp;
- offset av_offset;
-} s_a_val;
-
-typedef struct {
- short ac_length;
- argb_t ac_con;
-} s_a_con;
-
-typedef union {
- offset a_offset;
- num_p a_np;
- sym_p a_sp;
- s_a_val a_val;
- argb_t a_string;
- s_a_con a_con;
-} un_a_a;
-
-struct arg {
- arg_p a_next;
- short a_typ;
- un_a_a a_a;
-};
-
-/* possible values for .a_typ
- */
-
-#define ARGOFF 0
-#define ARGNUM 1
-#define ARGSYM 2
-#define ARGVAL 3
-#define ARGSTR 4
-#define ARGICN 5
-#define ARGUCN 6
-#define ARGFCN 7
-
-typedef struct {
- sym_p lasv_sp;
- short lasv_short;
-} s_la_sval;
-
-typedef struct {
- sym_p lalv_sp;
- offset lalv_offset;
-} s_la_lval;
-
-typedef union {
- short la_short;
- offset la_offset;
- num_p la_np;
- sym_p la_sp;
- s_la_sval la_sval;
- s_la_lval la_lval;
- arg_p la_arg;
-} un_l_a;
-
-struct line {
- line_p l_next; /* maintains linked list */
- byte l_instr; /* instruction number */
- byte l_optyp; /* specifies what follows */
- un_l_a l_a;
-};
-
-/* Possible values for .l_optyp */
-
-#define OPNO 0 /* no operand */
-#define OPSHORT 1 /* 16 bit number */
-#define OPOFFSET 2 /* 16 or 32 bit number */
-#define OPNUMLAB 3 /* local label for branches */
-#define OPSYMBOL 4 /* global label or procedurename */
-#define OPSVAL 5 /* symbol + 16 bit constant */
-#define OPLVAL 6 /* symbol + 16 or 32 bit constant */
-#define OPLIST 7 /* operand list for some pseudos */
-#define OPMINI 8 /* start of minis */
-
-#define Z_OPMINI (OPMINI+100) /* tunable */
-
-#define CANMINI(x) ((x)>=OPMINI-Z_OPMINI && (x)<256-Z_OPMINI)
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "lookup.h"
-#include "alloc.h"
-#include "proinf.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-unsigned hash(string) char *string; {
- register char *p;
- register unsigned i,sum;
-
- for (sum=i=0,p=string;*p;i += 3)
- sum ^= (*p++)<<(i&07);
- return(sum);
-}
-
-sym_p symlookup(name,status,flags) char *name; int status,flags; {
- register sym_p *spp,sp;
- register i;
- static short genfrag = 32767;
-
- spp = &symhash[hash(name)%NSYMHASH];
- while (*spp != (sym_p) 0)
- if (strncmp((*spp)->s_name,name,IDL)==0) {
- sp = *spp;
- if ((sp->s_flags^flags)&SYMPRO)
- error("%s is both proc and datalabel",name);
- if (status == DEFINING) {
- if (sp->s_flags&SYMDEF)
- error("redefined symbol %s",name);
- sp->s_flags |= SYMDEF;
- }
- return(sp);
- } else
- spp = &(*spp)->s_next;
-
- /*
- * symbol not found, enter in table
- */
-
- i = strlen(name) + 1;
- if (i & 1)
- i++;
- if (i > IDL)
- i = IDL;
- *spp = sp = newsym(i);
- strncpy(sp->s_name,name,i);
- sp->s_flags = flags;
- if (status == DEFINING)
- sp->s_flags |= SYMDEF;
- sp->s_frag = genfrag--;
- return(sp);
-}
-
-num_p numlookup(number) unsigned number; {
- register num_p *npp, np;
-
- npp = &curpro.numhash[number%NNUMHASH];
- while (*npp != (num_p) 0)
- if ((*npp)->n_number == number)
- return(*npp);
- else
- npp = &(*npp)->n_next;
-
- /*
- * local label not found, enter in tabel
- */
-
- *npp = np = newnum();
- np->n_number = number;
- np->n_repl = np;
- return(np);
-}
+++ /dev/null
-/* $Header$ */
-
-#define IDL 100
-
-struct sym {
- sym_p s_next;
- offset *s_rom;
- short s_flags;
- short s_frag;
- offset s_value;
- char s_name[2]; /* to be extended up to IDL */
-};
-
-/* contents of .s_flags */
-#define SYMPRO 000001
-#define SYMGLOBAL 000002
-#define SYMKNOWN 000004
-#define SYMOUT 000010
-#define SYMDEF 000020
-
-#define NSYMHASH 127
-extern sym_p symhash[NSYMHASH],symlookup();
-#define OCCURRING 0
-#define DEFINING 1
-#define NOTHING 2
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "alloc.h"
-#include "../../h/em_spec.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/*
- * Main program for EM optimizer
- */
-
-main(argc,argv) int argc; char *argv[]; {
- short somespace[STACKROOM];
-
- progname = argv[0];
- while (argc-->1 && **++argv == '-')
- flags(*argv);
- if (argc>1) {
- fprintf(stderr,"Usage: %s [-Ln] [name]\n",progname);
- exit(-1);
- }
- if (argc)
- if (freopen(*argv,"r",stdin) == NULL)
- error("Cannot open %s",*argv);
- fileinit();
- coreinit(somespace,somespace+STACKROOM);
- getlines();
- cleanup();
- return(0);
-}
-
-flags(s) register char *s; {
-
- for (s++;*s;s++)
- switch(*s) {
- case 'L': Lflag = TRUE; break;
- case 'n': nflag = TRUE; break;
- }
-}
-
-fileinit() {
- char *mktemp();
- short readshort();
-
- if (readshort() != (short) sp_magic)
- error("wrong input file");
- if (Lflag) {
- outfile = fopen(mktemp(template),"w");
- if (outfile == NULL)
- error("can't create %s",template);
- } else {
- outfile = stdout;
- outshort(sp_magic);
- }
-}
+++ /dev/null
-: '$Header$'
-for extension in c y
-do
- for file in *.$extension
- do ofile=`basename $file .$extension`.o
- grep '^# *include.*"' $file|sed "s/.*\"\(.*\)\".*/$ofile: \1/"
- done
-done | sort -u >depend
-ed - Makefile <<'!'
-/AUTOAUTOAUTO/+,$d
-$r depend
-w
-q
-!
-rm -f depend
+++ /dev/null
-%{
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "pattern.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mnem.h"
-#include "optim.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define MAXNODES 1000
-expr_t nodes[MAXNODES];
-expr_p lastnode = nodes+1;
-int curind,prevind;
-int patlen,maxpatlen,rpllen;
-int lino = 1;
-int patno=1;
-#define MAX 100
-int patmnem[MAX],rplmnem[MAX],rplexpr[MAX];
-byte nparam[N_EX_OPS];
-bool nonumlab[N_EX_OPS];
-bool onlyconst[N_EX_OPS];
-int nerrors=0;
-%}
-
-%union {
- int y_int;
-}
-
-%left OR2
-%left AND2
-%left OR1
-%left XOR1
-%left AND1
-%left CMPEQ,CMPNE
-%left CMPLT,CMPLE,CMPGT,CMPGE
-%left RSHIFT,LSHIFT
-%left ARPLUS,ARMINUS
-%left ARTIMES,ARDIVIDE,ARMOD
-%nonassoc NOT,COMP,UMINUS
-%nonassoc '$'
-
-%token SFIT,UFIT,NOTREG,PSIZE,WSIZE,DEFINED,SAMESIGN,ROM,ROTATE
-%token <y_int> MNEM
-%token <y_int> NUMBER
-%type <y_int> expr,argno,optexpr
-
-%start patternlist
-
-%%
-patternlist
- : /* empty */
- | patternlist '\n'
- | patternlist pattern
- ;
-pattern :
- mnemlist optexpr ':' replacement '\n'
- { register i;
- outbyte(0); outshort(prevind); prevind=curind-3;
- out(patlen);
- for (i=0;i<patlen;i++) outbyte(patmnem[i]);
- out($2);
- out(rpllen);
- for (i=0;i<rpllen;i++) {
- outbyte(rplmnem[i]);
- out(rplexpr[i]);
- }
-#ifdef DIAGOPT
- outshort(patno);
-#endif
- patno++;
- printf("\n");
- if (patlen>maxpatlen) maxpatlen=patlen;
- }
- | error '\n'
- { yyerrok; }
- ;
-replacement
- : expr /* special optimization */
- {
-#ifdef ALLOWSPECIAL
- rpllen=1; rplmnem[0]=0; rplexpr[0]=$1;
-#else
- yyerror("No specials allowed");
-#endif
- }
- | repllist
- ;
-repllist: /* empty */
- { rpllen=0; }
- | repllist repl
- ;
-repl : MNEM optexpr
- { rplmnem[rpllen] = $1; rplexpr[rpllen++] = $2; }
- ;
-mnemlist: MNEM
- { patlen=0; patmnem[patlen++] = $1; }
- | mnemlist MNEM
- { patmnem[patlen++] = $2; }
- ;
-optexpr : /* empty */
- { $$ = 0; }
- | expr
- ;
-expr
- : '$' argno
- { $$ = lookup(0,EX_ARG,$2,0); }
- | NUMBER
- { $$ = lookup(0,EX_CON,(int)(short)$1,0); }
- | PSIZE
- { $$ = lookup(0,EX_POINTERSIZE,0,0); }
- | WSIZE
- { $$ = lookup(0,EX_WORDSIZE,0,0); }
- | DEFINED '(' expr ')'
- { $$ = lookup(0,EX_DEFINED,$3,0); }
- | SAMESIGN '(' expr ',' expr ')'
- { $$ = lookup(1,EX_SAMESIGN,$3,$5); }
- | SFIT '(' expr ',' expr ')'
- { $$ = lookup(0,EX_SFIT,$3,$5); }
- | UFIT '(' expr ',' expr ')'
- { $$ = lookup(0,EX_UFIT,$3,$5); }
- | ROTATE '(' expr ',' expr ')'
- { $$ = lookup(0,EX_ROTATE,$3,$5); }
- | NOTREG '(' expr ')'
- { $$ = lookup(0,EX_NOTREG,$3,0); }
- | ROM '(' argno ',' expr ')'
- { $$ = lookup(0,EX_ROM,$3,$5); }
- | '(' expr ')'
- { $$ = $2; }
- | expr CMPEQ expr
- { $$ = lookup(1,EX_CMPEQ,$1,$3); }
- | expr CMPNE expr
- { $$ = lookup(1,EX_CMPNE,$1,$3); }
- | expr CMPGT expr
- { $$ = lookup(0,EX_CMPGT,$1,$3); }
- | expr CMPGE expr
- { $$ = lookup(0,EX_CMPGE,$1,$3); }
- | expr CMPLT expr
- { $$ = lookup(0,EX_CMPLT,$1,$3); }
- | expr CMPLE expr
- { $$ = lookup(0,EX_CMPLE,$1,$3); }
- | expr OR2 expr
- { $$ = lookup(0,EX_OR2,$1,$3); }
- | expr AND2 expr
- { $$ = lookup(0,EX_AND2,$1,$3); }
- | expr OR1 expr
- { $$ = lookup(1,EX_OR1,$1,$3); }
- | expr XOR1 expr
- { $$ = lookup(1,EX_XOR1,$1,$3); }
- | expr AND1 expr
- { $$ = lookup(1,EX_AND1,$1,$3); }
- | expr ARPLUS expr
- { $$ = lookup(1,EX_PLUS,$1,$3); }
- | expr ARMINUS expr
- { $$ = lookup(0,EX_MINUS,$1,$3); }
- | expr ARTIMES expr
- { $$ = lookup(1,EX_TIMES,$1,$3); }
- | expr ARDIVIDE expr
- { $$ = lookup(0,EX_DIVIDE,$1,$3); }
- | expr ARMOD expr
- { $$ = lookup(0,EX_MOD,$1,$3); }
- | expr LSHIFT expr
- { $$ = lookup(0,EX_LSHIFT,$1,$3); }
- | expr RSHIFT expr
- { $$ = lookup(0,EX_RSHIFT,$1,$3); }
- | ARPLUS expr %prec UMINUS
- { $$ = $2; }
- | ARMINUS expr %prec UMINUS
- { $$ = lookup(0,EX_UMINUS,$2,0); }
- | NOT expr
- { $$ = lookup(0,EX_NOT,$2,0); }
- | COMP expr
- { $$ = lookup(0,EX_COMP,$2,0); }
- ;
-argno : NUMBER
- { if ($1<1 || $1>patlen) {
- YYERROR;
- }
- $$ = (int) $1;
- }
- ;
-
-%%
-
-extern char em_mnem[][4];
-
-#define HASHSIZE (2*(sp_lmnem-sp_fmnem))
-
-struct hashmnem {
- char h_name[3];
- byte h_value;
-} hashmnem[HASHSIZE];
-
-inithash() {
- register i;
-
- enter("lab",op_lab);
- enter("LLP",op_LLP);
- enter("LEP",op_LEP);
- enter("SLP",op_SLP);
- enter("SEP",op_SEP);
- for(i=0;i<=sp_lmnem-sp_fmnem;i++)
- enter(em_mnem[i],i+sp_fmnem);
-}
-
-unsigned hashname(name) register char *name; {
- register unsigned h;
-
- h = (*name++)&BMASK;
- h = (h<<4)^((*name++)&BMASK);
- h = (h<<4)^((*name++)&BMASK);
- return(h);
-}
-
-enter(name,value) char *name; {
- register unsigned h;
-
- h=hashname(name)%HASHSIZE;
- while (hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- strncpy(hashmnem[h].h_name,name,3);
- hashmnem[h].h_value = value;
-}
-
-int mlookup(name) char *name; {
- register unsigned h;
-
- h = hashname(name)%HASHSIZE;
- while (strncmp(hashmnem[h].h_name,name,3) != 0 &&
- hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- return(hashmnem[h].h_value&BMASK); /* 0 if not found */
-}
-
-main() {
-
- inithash();
- initio();
- yyparse();
- if (nerrors==0)
- printnodes();
- return nerrors;
-}
-
-yyerror(s) char *s; {
-
- fprintf(stderr,"line %d: %s\n",lino,s);
- nerrors++;
-}
-
-lookup(comm,operator,lnode,rnode) {
- register expr_p p;
-
- for (p=nodes+1;p<lastnode;p++) {
- if (p->ex_operator != operator)
- continue;
- if (!(p->ex_lnode == lnode && p->ex_rnode == rnode ||
- comm && p->ex_lnode == rnode && p->ex_rnode == lnode))
- continue;
- return(p-nodes);
- }
- if (lastnode >= &nodes[MAXNODES])
- yyerror("node table overflow");
- lastnode++;
- p->ex_operator = operator;
- p->ex_lnode = lnode;
- p->ex_rnode = rnode;
- return(p-nodes);
-}
-
-printnodes() {
- register expr_p p;
-
- printf("};\n\nshort lastind = %d;\n\nexpr_t enodes[] = {\n",prevind);
- for (p=nodes;p<lastnode;p++)
- printf("/* %3d */\t%3d,%6u,%6u,\n",
- p-nodes,p->ex_operator,p->ex_lnode,p->ex_rnode);
- printf("};\n\niarg_t iargs[%d];\n",maxpatlen);
-}
-
-initio() {
- register i;
-
- printf("#include \"param.h\"\n#include \"types.h\"\n");
- printf("#include \"pattern.h\"\n\n");
- for(i=0;i<N_EX_OPS;i++) {
- nparam[i]=2;
- nonumlab[i]=TRUE;
- onlyconst[i]=TRUE;
- }
- nparam[EX_POINTERSIZE] = 0;
- nparam[EX_WORDSIZE] = 0;
- nparam[EX_CON] = 0;
- nparam[EX_ROM] = 0;
- nparam[EX_ARG] = 0;
- nparam[EX_DEFINED] = 0;
- nparam[EX_OR2] = 1;
- nparam[EX_AND2] = 1;
- nparam[EX_UMINUS] = 1;
- nparam[EX_NOT] = 1;
- nparam[EX_COMP] = 1;
- nparam[EX_NOTREG] = 1;
- nonumlab[EX_CMPEQ] = FALSE;
- nonumlab[EX_CMPNE] = FALSE;
- onlyconst[EX_CMPEQ] = FALSE;
- onlyconst[EX_CMPNE] = FALSE;
- onlyconst[EX_CMPLE] = FALSE;
- onlyconst[EX_CMPLT] = FALSE;
- onlyconst[EX_CMPGE] = FALSE;
- onlyconst[EX_CMPGT] = FALSE;
- onlyconst[EX_PLUS] = FALSE;
- onlyconst[EX_MINUS] = FALSE;
- printf("byte nparam[] = {");
- for (i=0;i<N_EX_OPS;i++) printf("%d,",nparam[i]);
- printf("};\nbool nonumlab[] = {");
- for (i=0;i<N_EX_OPS;i++) printf("%d,",nonumlab[i]);
- printf("};\nbool onlyconst[] = {");
- for (i=0;i<N_EX_OPS;i++) printf("%d,",onlyconst[i]);
- printf("};\n\nbyte pattern[] = { 0\n");
- curind = 1;
-}
-
-outbyte(b) {
-
- printf(",%3d",b);
- curind++;
-}
-
-outshort(s) {
-
- outbyte(s&0377);
- outbyte((s>>8)&0377);
-}
-
-out(w) {
-
- if (w<255) {
- outbyte(w);
- } else {
- outbyte(255);
- outshort(w);
- }
-}
-
-#include "scan.c"
+++ /dev/null
-/* $Header$ */
-
-/* #define DIAGOPT /* if defined diagnostics are produced */
-#ifdef DIAGOPT
-#define OPTIM(x) optim(x)
-#define O_UNREACH 1001
-#define O_BRALAB 1002
-#define O_LINLNI 1003
-#define O_LINGONE 1004
-#else
-#define OPTIM(x) /* NOTHING */
-#endif
+++ /dev/null
-/* $Header$ */
-
-#define LONGOFF /* if defined long offsets are used */
-
-#define TRUE 1
-#define FALSE 0
-
-#define MAXROM 3
-
-#define op_lab (sp_lmnem+1)
-#define op_last op_lab
-#define ps_sym (sp_lpseu+1)
-#define ps_last ps_sym
-
-#define BMASK 0377
+++ /dev/null
-/* $Header$ */
-
-/*
- * pattern contains the optimization patterns in an apparently
- * unordered fashion. All patterns follow each other unaligned.
- * Each pattern looks as follows:
- * Byte 0: high byte of hash value associated with this pattern.
- * Byte 1-2: index of next pattern with same low byte of hash value.
- * Byte 3- : pattern and replacement.
- * First comes the pattern length
- * then the pattern opcodes,
- * then a boolean expression,
- * then the one-byte replacement length
- * then the intermixed pattern opcodes and operands or
- * 0 followed by the one-byte special optimization expression.
- * If the DIAGOPT option is set, the optimization is followed
- * by the line number in the tables.
- */
-
-/* #define ALLOWSPECIAL /* Special optimizations allowed */
-
-#define PO_HASH 0
-#define PO_NEXT 1
-#define PO_MATCH 3
-
-struct exprnode {
- short ex_operator;
- short ex_lnode;
- short ex_rnode;
-};
-typedef struct exprnode expr_t;
-typedef struct exprnode *expr_p;
-
-/*
- * contents of .ex_operator
- */
-
-#define EX_CON 0
-#define EX_ARG 1
-#define EX_CMPEQ 2
-#define EX_CMPNE 3
-#define EX_CMPGT 4
-#define EX_CMPGE 5
-#define EX_CMPLT 6
-#define EX_CMPLE 7
-#define EX_OR2 8
-#define EX_AND2 9
-#define EX_OR1 10
-#define EX_XOR1 11
-#define EX_AND1 12
-#define EX_PLUS 13
-#define EX_MINUS 14
-#define EX_TIMES 15
-#define EX_DIVIDE 16
-#define EX_MOD 17
-#define EX_LSHIFT 18
-#define EX_RSHIFT 19
-#define EX_UMINUS 20
-#define EX_NOT 21
-#define EX_COMP 22
-#define EX_ROM 23
-#define EX_NOTREG 24
-#define EX_POINTERSIZE 25
-#define EX_WORDSIZE 26
-#define EX_DEFINED 27
-#define EX_SAMESIGN 28
-#define EX_SFIT 29
-#define EX_UFIT 30
-#define EX_ROTATE 31
-#define N_EX_OPS 32 /* must be one higher then previous */
-
-
-/*
- * Definition of special opcodes used in patterns
- */
-
-#define op_pfirst op_LLP
-#define op_LLP (op_last+1)
-#define op_LEP (op_last+2)
-#define op_SLP (op_last+3)
-#define op_SEP (op_last+4)
-#define op_plast op_SEP
-
-/*
- * Definition of the structure in which instruction operands
- * are kept during pattern matching.
- */
-
-typedef struct eval eval_t;
-typedef struct eval *eval_p;
-
-struct eval {
- short e_typ;
- union {
- offset e_con;
- num_p e_np;
- } e_v;
-};
-
-/*
- * contents of .e_typ
- */
-#define EV_UNDEF 0
-#define EV_CONST 1
-#define EV_NUMLAB 2
-#define EV_FRAG 3 /* and all higher numbers */
-
-typedef struct iarg iarg_t;
-typedef struct iarg *iarg_p;
-
-struct iarg {
- eval_t ia_ev;
- sym_p ia_sp;
-};
-
-/*
- * The next extern declarations refer to data generated by mktab
- */
-
-extern byte pattern[];
-extern short lastind;
-extern iarg_t iargs[];
-extern byte nparam[];
-extern bool nonumlab[];
-extern bool onlyconst[];
-extern expr_t enodes[];
+++ /dev/null
-/* $Header$ */
-loc adi loc sbi $2==w && $4==w: loc $1-$3 adi w
-ldc adi ldc sbi $2==2*w && $4==2*w: ldc $1-$3 adi 2*w
-loc adi loc adi $2==w && $4==w: loc $1+$3 adi w
-ldc adi ldc adi $2==2*w && $4==2*w: ldc $1+$3 adi 2*w
-adp $1==0:
-adp adp : adp $1+$2
-adp lof : lof $1+$2
-adp ldf : ldf $1+$2
-adp loi $1!=0 && $2==w: lof $1
-adp loi $1!=0 && $2==2*w: ldf $1
-adp stf : stf $1+$2
-adp sdf : sdf $1+$2
-adp sti $1!=0 && $2==w: stf $1
-adp sti $1!=0 && $2==2*w: sdf $1
-asp $1==0:
-asp asp : asp $1+$2
-blm $1==0 : asp 2*p
-cmi zeq $1==w: beq $2
-cmi zge $1==w: bge $2
-cmi zgt $1==w: bgt $2
-cmi zle $1==w: ble $2
-cmi zlt $1==w: blt $2
-cmi zne $1==w: bne $2
-dvi ngi $1==$2: ngi $1 dvi $1
-lae adp : lae $1+$2
-lae blm $2==w: loi w ste $1
-lae blm $2==2*w: loi 2*w sde $1
-lae ldf : lde $1+$2
-lae lof : loe $1+$2
-lae loi $2==w: loe $1
-lae loi $2==2*w: lde $1
-#ifdef INT
-lae loi loe $3==$1-w && $2%w==0: lae $3 loi $2+w
-lae loi lde $3==$1-2*w && $2%w==0: lae $3 loi $2+2*w
-lae loi lae loi $1==$3+$4 && $2%w==0 && $4%w==0: lae $3 loi $2+$4
-lae sti ste $3==$1+$2: lae $1 sti $2+w
-lae sti sde $3==$1+$2: lae $1 sti $2+2*w
-lae sti loc ste $4==$1-w: loc $3 lae $4 sti $2+w
-lae sti lol ste $4==$1-w: lol $3 lae $4 sti $2+w
-#endif
-lae lae blm loe ste $4==$1+$3 && $5==$2+$3: lae $1 lae $2 blm $3+w
-lae lae blm lde sde $4==$1+$3 && $5==$2+$3: lae $1 lae $2 blm $3+2*w
-lae lae blm lae lae blm $4==$1+$3 && $5==$2+$3: lae $1 lae $2 blm $3+$6
-lae lal blm lae lal blm $4==$1+$3 && $5==$2+$3 && samesign($2,$5):
- lae $1 lal $2 blm $3+$6
-lal lae blm lal lae blm $4==$1+$3 && $5==$2+$3 && samesign($1,$4):
- lal $1 lae $2 blm $3+$6
-lal lal blm lal lal blm $4==$1+$3 && $5==$2+$3 && samesign($1,$4) && samesign($2,$5):
- lal $1 lal $2 blm $3+$6
-lal lal sbs $3==w && samesign($1,$2): loc $1-$2
-lae sdf : sde $1+$2
-lae stf : ste $1+$2
-lae sti $2==w: ste $1
-lae sti $2==2*w: sde $1
-lal adp samesign($1,$1+$2): lal $1+$2
-lal blm $2==w: loi w stl $1
-lal blm $2==2*w: loi 2*w sdl $1
-#ifdef INT
-lal sti loc stl notreg($4) && $4==$1-w && samesign($1,$4):
- loc $3 lal $4 sti $2+w
-lal sti loe stl notreg($4) && $4==$1-w && samesign($1,$4):
- loe $3 lal $4 sti $2+w
-#endif
-lal ldf samesign($1,$1+$2): ldl $1+$2
-lal lof samesign($1,$1+$2): lol $1+$2
-lal loi $2==w: lol $1
-lal loi $2==2*w: ldl $1
-#ifdef INT
-lal loi lol notreg($3) && $3==$1-w && samesign($1,$3) && $2%w==0:
- lal $3 loi $2+w
-lal loi ldl notreg($3) && $3==$1-2*w && samesign($1,$3) && $2%w==0:
- lal $3 loi $2+2*w
-lal loi lal loi $1==$3+$4 && samesign($1,$3) && $2%w==0 && $4%w==0:
- lal $3 loi $2+$4
-lal sti stl notreg($3) && $3==$1+$2 && samesign($1,$3): lal $1 sti $2+w
-lal sti sdl notreg($3) && $3==$1+$2 && samesign($1,$3): lal $1 sti $2+2*w
-#endif
-lal sdf samesign($1,$1+$2): sdl $1+$2
-lal stf samesign($1,$1+$2): stl $1+$2
-lal sti $2==w: stl $1
-lal sti $2==2*w: sdl $1
-#ifdef INT
-lde lde $2==$1-2*w: lae $2 loi 4*w
-lde loe $2==$1-w: lae $2 loi 3*w
-#endif
-lde sde $2==$1:
-lde sde lde sde $3==$1+2*w && $4==$2+2*w: lae $1 lae $2 blm 4*w
-#ifdef INT
-ldl ldl $2==$1-2*w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $2 loi 4*w
-ldl lol $2==$1-w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $2 loi 3*w
-#endif
-ldl sdl $1==$2:
-lxa loi lxa sti $3==$1 && $4==$2:
-lxa lof lxa stf $3==$1 && $4==$2:
-lxa ldf lxa sdf $3==$1 && $4==$2:
-lxa stf lxa lof $3==$1 && $4==$2: dup w lxa $1 stf $2
-lxa sdf lxa ldf $3==$1 && $4==$2: dup 2*w lxa $1 sdf $2
-lxl lof lxl stf $3==$1 && $4==$2:
-lxl ldf lxl sdf $3==$1 && $4==$2:
-lxl stf lxl lof $3==$1 && $4==$2: dup w lxl $1 stf $2
-lxl sdf lxl ldf $3==$1 && $4==$2: dup 2*w lxl $1 sdf $2
-lxa sti lxa loi $3==$1 && $4==$2 && $2%w==0: dup $2 lxa $1 sti $2
-loc adi $1==-1 && $2==w: dec
-loc dec sfit($1-1,8*w) : loc $1-1
-loc bgt $1==-1: zge $2
-loc ble $1==-1: zlt $2
-loc dvi $1==-1 && $2==w: ngi w
-ldc dvi $1==-1 && $2==2*w: ngi 2*w
-loc loe adi $1==-1 && $3==w: loe $2 dec
-loc loe mli $1==-1 && $3==w: loe $2 ngi w
-loc lol adi $1==-1 && $3==w: lol $2 dec
-loc mli $1==-1 && $2==w: ngi w
-ldc mli $1==-1 && $2==2*w: ngi 2*w
-loc sbi $1==-1 && $2==w: inc
-loc inc sfit($1+1,8*w) : loc $1+1
-loc adi $1==0 && $2==w:
-ldc adi $1==0 && $2==2*w:
-zer adi $1==$2:
-loc beq $1==0: zeq $2
-loc bge $1==0: zge $2
-loc bgt $1==0: zgt $2
-loc ble $1==0: zle $2
-loc blt $1==0: zlt $2
-loc bne $1==0: zne $2
-loc cmi teq $1==0 && $2==w: teq
-loc cmi tge $1==0 && $2==w: tge
-loc cmi tgt $1==0 && $2==w: tgt
-loc cmi tle $1==0 && $2==w: tle
-loc cmi tlt $1==0 && $2==w: tlt
-loc cmi tne $1==0 && $2==w: tne
-loc ior $1==0 && $2==w:
-ldc ior $1==0 && $2==2*w:
-zer ior $1==$2:
-loc ste $1==0: zre $2
-loc stl $1==0: zrl $2
-loc sbi $1==0 && $2==w:
-ldc sbi $1==0 && $2==2*w:
-zer sbi $1==$2:
-loc xor $1==0 && $2==w:
-ldc xor $1==0 && $2==2*w:
-zer xor $1==$2:
-loc adi $1==1 && $2==w: inc
-loc bge $1==1: zgt $2
-loc blt $1==1: zle $2
-loc dvi $1==1 && $2==w:
-ldc dvi $1==1 && $2==2*w:
-loc loe adi $1==1 && $3==w: loe $2 inc
-loc loe mli $1==1 && $3==w: loe $2
-loc lol adi $1==1 && $3==w: lol $2 inc
-loc lol mli $1==1 && $3==w: lol $2
-loc mli $1==1 && $2==w:
-loc sbi $1==1 && $2==w: dec
-loc loe mli $3==w: loe $2 loc $1 mli w
-loc lol mli $3==w: lol $2 loc $1 mli w
-ldc lde mli $3==2*w: lde $2 ldc $1 mli 2*w
-ldc lde adi $3==2*w: lde $2 ldc $1 adi 2*w
-ldc ldl mli $3==2*w: ldl $2 ldc $1 mli 2*w
-ldc ldl adi $3==2*w: ldl $2 ldc $1 adi 2*w
-loc mli $1==2 && $2==w: loc 1 sli w
-loc mli $1==4 && $2==w: loc 2 sli w
-loc mli $1==8 && $2==w: loc 3 sli w
-loc mli $1==16 && $2==w: loc 4 sli w
-loc mli $1==32 && $2==w: loc 5 sli w
-loc mli $1==64 && $2==w: loc 6 sli w
-loc mli $1==128 && $2==w: loc 7 sli w
-loc mli $1==256 && $2==w: loc 8 sli w
-loc adi !defined($2): adi $1
-loc sbi !defined($2): sbi $1
-loc mli !defined($2): mli $1
-loc dvi !defined($2): dvi $1
-loc rmi !defined($2): rmi $1
-loc ngi !defined($2): ngi $1
-loc sli !defined($2): sli $1
-loc sri !defined($2): sri $1
-loc adu !defined($2): adu $1
-loc sbu !defined($2): sbu $1
-loc mlu !defined($2): mlu $1
-loc dvu !defined($2): dvu $1
-loc rmu !defined($2): rmu $1
-loc slu !defined($2): slu $1
-loc sru !defined($2): sru $1
-loc adf !defined($2): adf $1
-loc sbf !defined($2): sbf $1
-loc mlf !defined($2): mlf $1
-loc dvf !defined($2): dvf $1
-loc ngf !defined($2): ngf $1
-loc fif !defined($2): fif $1
-loc fef !defined($2): fef $1
-loc zer !defined($2): zer $1
-loc zrf !defined($2): zrf $1
-loc los $2==w: loi $1
-loc sts $2==w: sti $1
-loc ads $2==w: adp $1
-loc ass $2==w: asp $1
-loc bls $2==w: blm $1
-loc dus $2==w: dup $1
-loc loc cii $1==$2:
-loc loc cuu $1==$2:
-loc loc cff $1==$2:
-loc and !defined($2): and $1
-loc ior !defined($2): ior $1
-loc xor !defined($2): xor $1
-loc com !defined($2): com $1
-loc rol !defined($2): rol $1
-loc rol $1==0:
-loc ror !defined($2): ror $1
-loc ror $1==0:
-loc inn !defined($2): inn $1
-loc set !defined($2): set $1
-loc cmi !defined($2): cmi $1
-loc cmu !defined($2): cmu $1
-loc cmf !defined($2): cmf $1
-loe dec ste $1==$3: dee $1
-loe inc ste $1==$3: ine $1
-loe loc mli $2==0 && $3==w: loc 0
-#ifdef INT
-loe loe $2==$1-w: lde $2
-loe loe beq $2==$1+w: lde $1 beq $3
-loe loe bge $2==$1+w: lde $1 ble $3
-loe loe bgt $2==$1+w: lde $1 blt $3
-loe loe ble $2==$1+w: lde $1 bge $3
-loe loe blt $2==$1+w: lde $1 bgt $3
-loe loe bne $2==$1+w: lde $1 bne $3
-loe loe cmi $2==$1+w && $3==w: lde $1 cmi w ngi w
-#endif
-ngi teq $1==w: teq
-ngi tge $1==w: tle
-ngi tgt $1==w: tlt
-ngi tle $1==w: tge
-ngi tlt $1==w: tgt
-ngi tne $1==w: tne
-#ifdef INT
-loe loe mli $2==$1+w && $3==w: lde $1 mli w
-loe loe adi $2==$1+w && $3==w: lde $1 adi w
-loe loe $1==$2: loe $1 dup w
-#endif
-loe ste $1==$2:
-LLP blm $2==w: loi w sil $1
-lol dec stl $1==$3: del $1
-lol inc stl $1==$3: inl $1
-lol loc mli $2==0 && $3==w: loc 0
-LLP loi $2==w: lil $1
-#ifdef INT
-lol lol $2==$1-w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $2
-lol lol beq $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 beq $3
-lol lol bge $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 ble $3
-lol lol bgt $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 blt $3
-lol lol ble $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 bge $3
-lol lol blt $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 bgt $3
-lol lol bne $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 bne $3
-lol lol cmi $3==w && $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 cmi w ngi w
-lol lol mli $3==w && $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 mli w
-lol lol adi $3==w && $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 adi w
-lol lol $1==$2: lol $1 dup w
-#endif
-lol stl $1==$2:
-LLP sti $2==w: sil $1
-mli ngi $1==$2: ngi $1 mli $1
-ngi adi $1==$2: sbi $1
-ngf adf $1==$2: sbf $1
-ngi sbi $1==$2: adi $1
-ngf sbf $1==$2: adf $1
-ngi ngi $1==$2:
-ngf ngf $1==$2:
-#ifdef INT
-sde sde $2==$1+2*w: lae $1 sti 4*w
-sde ste $2==$1+2*w: lae $1 sti 3*w
-sde loc ste $3==$1-w: loc $2 lae $3 sti 3*w
-sde lol ste $3==$1-w: lol $2 lae $3 sti 3*w
-sde lde $1==$2: dup 2*w sde $1
-#endif
-sdf $1==0: sti 2*w
-#ifdef INT
-sdl sdl $2==$1+2*w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $1 sti 4*w
-sdl stl $2==$1+2*w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $1 sti 3*w
-sdl loc stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loc $2 lal $3 sti 3*w
-sdl loe stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loe $2 lal $3 sti 3*w
-sdl ldl $1==$2: dup 2*w sdl $1
-ste loe $1==$2: dup w ste $1
-ste ste $2==$1-w: sde $2
-ste loc ste $3==$1-w: loc $2 sde $3
-ste lol ste $3==$1-w: lol $2 sde $3
-stl lol $1==$2: dup w stl $1
-#endif
-stf $1==0: sti w
-sdl ldl ret $1==$2 && $3==2*w: ret 2*w
-#ifdef INT
-stl stl $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2): sdl $1
-stl loc stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loc $2 sdl $3
-stl loe stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loe $2 sdl $3
-#endif
-stl lol ret $1==$2 && $3==w: ret w
-lal sti lal loi ret $1==$3 && $2==$4 && $2==$5: ret $2
-loc sbi loc sbi $2==w && $4==w: loc $1+$3 sbi w
-ldc sbi ldc sbi $2==2*w && $4==2*w: ldc $1+$3 sbi 2*w
-loc sbi loc adi $2==w && $4==w: loc $1-$3 sbi w
-ldc sbi ldc adi $2==2*w && $4==2*w: ldc $1-$3 sbi 2*w
-teq teq : tne
-teq tne : teq
-teq zne : zeq $2
-teq zeq : zne $2
-tge teq : tlt
-tge tne : tge
-tge zeq : zlt $2
-tge zne : zge $2
-tgt teq : tle
-tgt tne : tgt
-tgt zeq : zle $2
-tgt zne : zgt $2
-tle teq : tgt
-tle tne : tle
-tle zeq : zgt $2
-tle zne : zle $2
-tlt teq : tge
-tlt tne : tlt
-tlt zeq : zge $2
-tlt zne : zlt $2
-tne teq : teq
-tne tne : tne
-tne zeq : zeq $2
-tne zne : zne $2
-#ifdef INT
-loc loc loc $1==0 && $2==0 && $3==0 : zer 6
-zer loc defined($1) && $2==0: zer $1+w
-#endif
-loi loc and $1==1 && $3==w && ($2&255)==255: loi 1
-loi loc loc cii $1<w && $2==w: loi $1 loc $2 loc $3 cuu
-cmp teq : cms p teq
-cmp tne : cms p tne
-cmu teq defined($1): cms $1 teq
-cmu tne defined($1): cms $1 tne
-cms zeq $1==w: beq $2
-cms zne $1==w: bne $2
-lol lae aar adp $3==w: adp $4 lol $1 lae $2 aar w
-loe lae aar adp $3==w: adp $4 loe $1 lae $2 aar w
-cmi zeq defined($1): cms $1 zeq $2
-cmi zne defined($1): cms $1 zne $2
-loe inc dup ste $1==$4 && $3==w: ine $1 loe $1
-loe dec dup ste $1==$4 && $3==w: dee $1 loe $1
-lol inc dup stl $1==$4 && $3==w: inl $1 lol $1
-lol dec dup stl $1==$4 && $3==w: del $1 lol $1
-adp dup SEP adp $1==-$4 && $2==p: dup p adp $1 SEP $3
-adp dup SLP adp $1==-$4 && $2==p: dup p adp $1 SLP $3
-inc dup ste dec $2==w: dup w inc ste $3
-inc dup stl dec $2==w: dup w inc stl $3
-zeq bra lab $1==$3: zne $2 lab $1
-zge bra lab $1==$3: zlt $2 lab $1
-zgt bra lab $1==$3: zle $2 lab $1
-zlt bra lab $1==$3: zge $2 lab $1
-zle bra lab $1==$3: zgt $2 lab $1
-zne bra lab $1==$3: zeq $2 lab $1
-beq bra lab $1==$3: bne $2 lab $1
-bge bra lab $1==$3: blt $2 lab $1
-bgt bra lab $1==$3: ble $2 lab $1
-blt bra lab $1==$3: bge $2 lab $1
-ble bra lab $1==$3: bgt $2 lab $1
-bne bra lab $1==$3: beq $2 lab $1
-lin lin : lin $2
-lin lab lin : lab $2 lin $3
-lin ret : ret $2
-lin bra : bra $2
-dup SLP loi $1==p && $3==w: SLP $2 lil $2
-dup SLP sti $1==p && $3==w: SLP $2 sil $2
-loc cms $1==0 && $2==w: tne
-zer $1==w: loc 0
-loc loc adi $3==w && sfit($1+$2,8*w) : loc $1+$2
-loc loc sbi $3==w && sfit($1-$2,8*w) : loc $1-$2
-loc loc mli $3==w && sfit($1*$2,8*w) : loc $1*$2
-loc loc dvi $3==w && $2!=0 : loc $1/$2
-loc loc and $3==w : loc $1&$2
-loc loc ior $3==w : loc $1|$2
-loc loc ior $1==0 && $2==0 && $3==2*w :
-loc loc xor $3==w : loc $1^$2
-loc loc xor $1==0 && $2==0 && $3==2*w :
-loc loc rol $3==w : loc rotate($1,$2)
-loc loc ror $3==w : loc rotate($1,8*w-$2)
-loc ngi $2==w && sfit(-$1,8*w) : loc -$1
-loc com $2==w : loc ~$1
-ldc ngi $2==2*w : ldc -$1
-loc lae aar $3==w && $1>=rom(2,0) && $1 <= rom(2,0)+rom(2,1) :
- adp ($1-rom(2,0))*rom(2,2)
-loc lae lar $3==w && $1>=rom(2,0) && $1 <= rom(2,0)+rom(2,1) :
- adp ($1-rom(2,0))*rom(2,2) loi rom(2,2)
-loc lae sar $3==w && $1>=rom(2,0) && $1 <= rom(2,0)+rom(2,1) :
- adp ($1-rom(2,0))*rom(2,2) sti rom(2,2)
-loc teq : loc $1==0
-loc tne : loc $1!=0
-loc tge : loc $1>=0
-loc tle : loc $1<=0
-loc tgt : loc $1>0
-loc tlt : loc $1<0
-loc zeq $1==0 : bra $2
-loc zeq :
-loc zne $1!=0 : bra $2
-loc zne :
-loc zge $1>=0 : bra $2
-loc zge :
-loc zle $1<=0 : bra $2
-loc zle :
-loc zgt $1>0 : bra $2
-loc zgt :
-loc zlt $1<0 : bra $2
-loc zlt :
-loc loc beq $1==$2 : bra $3
-loc loc beq :
-loc loc bne $1!=$2 : bra $3
-loc loc bne :
-loc loc bge $1>=$2 : bra $3
-loc loc bge :
-loc loc ble $1<=$2 : bra $3
-loc loc ble :
-loc loc bgt $1>$2 : bra $3
-loc loc bgt :
-loc loc blt $1<$2 : bra $3
-loc loc blt :
-lae loi lal sti $2==$4 && $2>4*w : lae $1 lal $3 blm $2
-lal loi lae sti $2==$4 && $2>4*w : lal $1 lae $3 blm $2
-lal loi lal sti $2==$4 && $2>4*w && ( $3<=$1-$2 || $3>=$1+$2 ) :
- lal $1 lal $3 blm $2
-lae loi lae sti $2==$4 && $2>4*w && ( !defined($1==$3) || $3<=$1-$2 || $3>=$1+$2 ) :
- lae $1 lae $3 blm $2
-loc loc loc cif $1==0 && $2==w : zrf $3
-loc loc loc ciu $1>=0 && $2==w && $3==2*w : ldc $1
-loc loc loc cii $2==w && $3==2*w : ldc $1
-loi loc inn $1==$3 && $2>=0 && $2<$1*8 :
- lof ($2/(8*w))*w loc $2&(8*w-1) inn w
-ldl loc inn $3==2*w && $2>=0 && $2<16*w :
- lol $1+($2/(8*w))*w loc $2&(8*w-1) inn w
-lde loc inn $3==2*w && $2>=0 && $2<16*w :
- loe $1+($2/(8*w))*w loc $2&(8*w-1) inn w
-ldf loc inn $3==2*w && $2>=0 && $2<16*w :
- lof $1+($2/(8*w))*w loc $2&(8*w-1) inn w
-loc inn $1<0 || $1>=8*$2 : asp $2 loc 0
-lol loc adi stl $3==w && $1==$4 : loc $2 lol $1 adi w stl $4
-lol loe adi stl $3==w && $1==$4 : loe $2 lol $1 adi w stl $4
-lol lol adi stl $3==w && $1==$4 && $1!=$2 : lol $2 lol $1 adi w stl $4
-loe loc adi ste $3==w && $1==$4 : loc $2 loe $1 adi w ste $4
-loe loe adi ste $3==w && $1==$4 && $1!=$2 : loe $2 loe $1 adi w ste $4
-loe lol adi ste $3==w && $1==$4 : lol $2 loe $1 adi w ste $4
-lol loc ior stl $3==w && $1==$4 : loc $2 lol $1 ior w stl $4
-lol loe ior stl $3==w && $1==$4 : loe $2 lol $1 ior w stl $4
-lol lol ior stl $3==w && $1==$4 && $1!=$2 : lol $2 lol $1 ior w stl $4
-loe loc ior ste $3==w && $1==$4 : loc $2 loe $1 ior w ste $4
-loe loe ior ste $3==w && $1==$4 && $1!=$2 : loe $2 loe $1 ior w ste $4
-loe lol ior ste $3==w && $1==$4 : lol $2 loe $1 ior w ste $4
-lol loc and stl $3==w && $1==$4 : loc $2 lol $1 and w stl $4
-lol loe and stl $3==w && $1==$4 : loe $2 lol $1 and w stl $4
-lol lol and stl $3==w && $1==$4 && $1!=$2 : lol $2 lol $1 and w stl $4
-loe loc and ste $3==w && $1==$4 : loc $2 loe $1 and w ste $4
-loe loe and ste $3==w && $1==$4 && $1!=$2 : loe $2 loe $1 and w ste $4
-loe lol and ste $3==w && $1==$4 : lol $2 loe $1 and w ste $4
-loi asp $1==$2 : asp p
-lal loi loc loc loc loc ior $2==4*w && $7==4*w && ($3==0)+($4==0)+($5==0)+($6==0)>2 :
- lol $1+3*w loc $3 ior w lol $1+2*w loc $4 ior w lol $1+w loc $5 ior w lol $1 loc $6 ior w
-loc dup stl loc dup stl $2==2 && $5==2:
- loc $1 stl $3 loc $4 stl $6 loc $1 loc $4
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "alloc.h"
-#include "pattern.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mnem.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/* #define CHK_HASH /* print numbers patterns are hashed to */
-#ifdef CHK_HASH
-#include <stdio.h>
-#endif
-
-#define ILLHASH 0177777
-short pathash[256]; /* table of indices into pattern[] */
-
-int opind = 0; /* second index of next matrix */
-byte transl[op_plast-op_pfirst+1][3] = {
- /* LLP */ { op_LLP, op_lol, op_ldl },
- /* LEP */ { op_LEP, op_loe, op_lde },
- /* SLP */ { op_SLP, op_stl, op_sdl },
- /* SEP */ { op_SEP, op_ste, op_sde }
-};
-
-opcheck(bp) register byte *bp; {
-
- if (((*bp)&BMASK) >= op_pfirst)
- *bp = transl[((*bp)&BMASK)-op_pfirst][opind];
-}
-
-/*
- * The hashing method used is believed to be reasonably efficient.
- * A minor speed improvement could be obtained by keeping a boolean
- * array telling which opcode has any patterns starting with it.
- * Currently only about one third of the opcodes actually have a
- * pattern starting with it, but they are the most common ones.
- * Estimated improvement possible: about 2%
- */
-
-hashpatterns() {
- short index;
- register byte *bp,*tp;
- register short i;
- unsigned short hashvalue;
- byte *save;
- int patlen;
-
- if (pointersize == wordsize)
- opind=1;
- else if (pointersize == 2*wordsize)
- opind=2;
- index = lastind; /* set by mktab */
- while (index != 0) {
- bp = &pattern[index];
- tp = &bp[PO_MATCH];
- i = *tp++&BMASK;
- if (i==BMASK) {
- i = *tp++&BMASK;
- i |= (*tp++&BMASK)<<8;
- }
- save = tp;
- patlen = i;
- while (i--)
- opcheck(tp++);
- if ((*tp++&BMASK)==BMASK)
- tp += 2;
- i = *tp++&BMASK;
- if (i==BMASK) {
- i = *tp++&BMASK;
- i |= (*tp++&BMASK)<<8;
- }
- while (i--) {
- opcheck(tp++);
- if ((*tp++&BMASK)==BMASK)
- tp += 2;
- }
-
- /*
- * Now the special opcodes are filled
- * in properly, we can hash the pattern
- */
-
- hashvalue = 0;
- tp = save;
- switch(patlen) {
- default: /* 3 or more */
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 2:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 1:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- }
- assert(hashvalue!= ILLHASH);
- i=index;
- index = (bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<8);
- bp[PO_HASH] = hashvalue>>8;
- hashvalue &= BMASK;
- bp[PO_NEXT] = pathash[hashvalue]&BMASK;
- bp[PO_NEXT+1] = pathash[hashvalue]>>8;
- pathash[hashvalue] = i;
-#ifdef CHK_HASH
- fprintf(stderr,"%d\n",hashvalue);
-#endif
- }
-}
-
-peephole() {
- static bool phashed = FALSE;
-
- if (!phashed) {
- hashpatterns();
- phashed=TRUE;
- }
- optimize();
-}
-
-optimize() {
- register num_p *npp,np;
- register instr;
-
- basicblock(&instrs);
- for (npp=curpro.numhash;npp< &curpro.numhash[NNUMHASH]; npp++)
- for (np = *npp; np != (num_p) 0; np=np->n_next) {
- if(np->n_line->l_next == (line_p) 0)
- continue;
- instr = np->n_line->l_next->l_instr&BMASK;
- if (instr == op_lab || instr == op_bra)
- np->n_repl = np->n_line->l_next->l_a.la_np;
- else
- basicblock(&np->n_line->l_next);
- }
-}
-
-offset oabs(off) offset off; {
-
- return(off >= 0 ? off : -off);
-}
-
-line_p repline(ev,patlen) eval_t ev; {
- register line_p lp;
- register iarg_p iap;
- register sym_p sp;
- offset diff,newdiff;
-
- assert(ev.e_typ != EV_UNDEF);
- switch(ev.e_typ) {
- case EV_CONST:
- if ((short) ev.e_v.e_con == ev.e_v.e_con) {
- if (CANMINI((short) ev.e_v.e_con))
- lp = newline((short) (ev.e_v.e_con)+Z_OPMINI);
- else {
- lp = newline(OPSHORT);
- lp->l_a.la_short = (short) ev.e_v.e_con;
- }
- } else {
- lp = newline(OPOFFSET);
- lp->l_a.la_offset = ev.e_v.e_con;
- }
- return(lp);
- case EV_NUMLAB:
- lp = newline(OPNUMLAB);
- lp->l_a.la_np = ev.e_v.e_np;
- return(lp);
- default: /* fragment + offset */
- /*
- * There is a slight problem here, because we have to
- * map fragment+offset to symbol+offset.
- * Fortunately the fragment we have must be the fragment
- * of one of the symbols in the matchpattern.
- * So a short search should do the job.
- */
- sp = (sym_p) 0;
- for (iap= &iargs[patlen-1]; iap >= iargs; iap--)
- if (iap->ia_ev.e_typ == ev.e_typ) {
- /*
- * Although lint complains, diff is not used
- * before set.
- *
- * The proof is left as an exercise to the
- * reader.
- */
- newdiff = oabs(iap->ia_sp->s_value-ev.e_v.e_con);
- if (sp==(sym_p) 0 || newdiff < diff) {
- sp = iap->ia_sp;
- diff = newdiff;
- }
- }
- assert(sp != (sym_p) 0);
- if (diff == 0) {
- lp = newline(OPSYMBOL);
- lp->l_a.la_sp = sp;
- } else {
- diff = ev.e_v.e_con - sp->s_value;
- if ((short) diff == diff) {
- lp = newline(OPSVAL);
- lp->l_a.la_sval.lasv_short = (short) diff;
- lp->l_a.la_sval.lasv_sp = sp;
- } else {
- lp = newline(OPLVAL);
- lp->l_a.la_lval.lalv_offset = diff;
- lp->l_a.la_lval.lalv_sp = sp;
- }
- }
- return(lp);
- }
-}
-
-offset rotate(w,amount) offset w,amount; {
- offset highmask,lowmask;
-
-#ifndef LONGOFF
- assert(wordsize<=4);
-#endif
- highmask = (offset)(-1) << amount;
- lowmask = ~highmask;
- if (wordsize != 4)
- highmask &= wordsize==2 ? 0xFFFF : 0xFF;
- return(((w<<amount)&highmask)|((w>>(8*wordsize-amount))&lowmask));
-}
-
-eval_t undefres = { EV_UNDEF };
-
-eval_t compute(pexp) register expr_p pexp; {
- eval_t leaf1,leaf2,res;
- register i;
- register sym_p sp;
- offset mask;
-
- switch(nparam[pexp->ex_operator]) {
- default:
- assert(FALSE);
- case 2:
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ == EV_UNDEF ||
- nonumlab[pexp->ex_operator] && leaf2.e_typ == EV_NUMLAB ||
- onlyconst[pexp->ex_operator] && leaf2.e_typ != EV_CONST)
- return(undefres);
- case 1:
- leaf1 = compute(&enodes[pexp->ex_lnode]);
- if (leaf1.e_typ == EV_UNDEF ||
- nonumlab[pexp->ex_operator] && leaf1.e_typ == EV_NUMLAB ||
- onlyconst[pexp->ex_operator] && leaf1.e_typ != EV_CONST)
- return(undefres);
- case 0:
- break;
- }
-
- res.e_typ = EV_CONST;
- res.e_v.e_con = 0;
- switch(pexp->ex_operator) {
- default:
- assert(FALSE);
- case EX_CON:
- res.e_v.e_con = (offset) pexp->ex_lnode;
- break;
- case EX_ARG:
- return(iargs[pexp->ex_lnode - 1].ia_ev);
- case EX_CMPEQ:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- if (leaf1.e_typ == EV_NUMLAB) {
- if (leaf1.e_v.e_np == leaf2.e_v.e_np)
- res.e_v.e_con = 1;
- break;
- }
- if (leaf1.e_v.e_con == leaf2.e_v.e_con)
- res.e_v.e_con = 1;
- break;
- case EX_CMPNE:
- if (leaf1.e_typ != leaf2.e_typ) {
- res.e_v.e_con = 1;
- break;
- }
- if (leaf1.e_typ == EV_NUMLAB) {
- if (leaf1.e_v.e_np != leaf2.e_v.e_np)
- res.e_v.e_con = 1;
- break;
- }
- if (leaf1.e_v.e_con != leaf2.e_v.e_con)
- res.e_v.e_con = 1;
- break;
- case EX_CMPGT:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con > leaf2.e_v.e_con;
- break;
- case EX_CMPGE:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con >= leaf2.e_v.e_con;
- break;
- case EX_CMPLT:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con < leaf2.e_v.e_con;
- break;
- case EX_CMPLE:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con <= leaf2.e_v.e_con;
- break;
- case EX_OR2:
- if (leaf1.e_v.e_con != 0)
- return(leaf1);
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ != EV_CONST)
- return(undefres);
- return(leaf2);
- case EX_AND2:
- if (leaf1.e_v.e_con == 0)
- return(leaf1);
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ != EV_CONST)
- return(undefres);
- return(leaf2);
- case EX_OR1:
- res.e_v.e_con = leaf1.e_v.e_con | leaf2.e_v.e_con;
- break;
- case EX_XOR1:
- res.e_v.e_con = leaf1.e_v.e_con ^ leaf2.e_v.e_con;
- break;
- case EX_AND1:
- res.e_v.e_con = leaf1.e_v.e_con & leaf2.e_v.e_con;
- break;
- case EX_TIMES:
- res.e_v.e_con = leaf1.e_v.e_con * leaf2.e_v.e_con;
- break;
- case EX_DIVIDE:
- res.e_v.e_con = leaf1.e_v.e_con / leaf2.e_v.e_con;
- break;
- case EX_MOD:
- res.e_v.e_con = leaf1.e_v.e_con % leaf2.e_v.e_con;
- break;
- case EX_LSHIFT:
- res.e_v.e_con = leaf1.e_v.e_con << leaf2.e_v.e_con;
- break;
- case EX_RSHIFT:
- res.e_v.e_con = leaf1.e_v.e_con >> leaf2.e_v.e_con;
- break;
- case EX_UMINUS:
- res.e_v.e_con = -leaf1.e_v.e_con;
- break;
- case EX_NOT:
- res.e_v.e_con = !leaf1.e_v.e_con;
- break;
- case EX_COMP:
- res.e_v.e_con = ~leaf1.e_v.e_con;
- break;
- case EX_PLUS:
- if (leaf1.e_typ >= EV_FRAG) {
- if (leaf2.e_typ >= EV_FRAG)
- return(undefres);
- res.e_typ = leaf1.e_typ;
- } else
- res.e_typ = leaf2.e_typ;
- res.e_v.e_con = leaf1.e_v.e_con + leaf2.e_v.e_con;
- break;
- case EX_MINUS:
- if (leaf1.e_typ >= EV_FRAG) {
- if (leaf2.e_typ == EV_CONST)
- res.e_typ = leaf1.e_typ;
- else if (leaf2.e_typ != leaf1.e_typ)
- return(undefres);
- } else if (leaf2.e_typ >= EV_FRAG)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con - leaf2.e_v.e_con;
- break;
- case EX_POINTERSIZE:
- res.e_v.e_con = pointersize;
- break;
- case EX_WORDSIZE:
- res.e_v.e_con = wordsize;
- break;
- case EX_NOTREG:
- res.e_v.e_con = !inreg(leaf1.e_v.e_con);
- break;
- case EX_DEFINED:
- leaf1 = compute(&enodes[pexp->ex_lnode]);
- res.e_v.e_con = leaf1.e_typ != EV_UNDEF;
- break;
- case EX_SAMESIGN:
- res.e_v.e_con = (leaf1.e_v.e_con ^ leaf2.e_v.e_con) >= 0;
- break;
- case EX_ROM:
- if ((sp = iargs[pexp->ex_lnode - 1].ia_sp) != (sym_p) 0 &&
- sp->s_rom != (offset *) 0) {
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ != EV_CONST ||
- leaf2.e_v.e_con < 0 ||
- leaf2.e_v.e_con >= MAXROM)
- return(undefres);
- res.e_v.e_con = sp->s_rom[leaf2.e_v.e_con];
- break;
- } else
- return(undefres);
- case EX_SFIT:
- mask = 0;
- for (i=leaf2.e_v.e_con - 1;i < 8*sizeof(offset); i++)
- mask |= 1<<i;
- res.e_v.e_con = (leaf1.e_v.e_con&mask) == 0 ||
- (leaf1.e_v.e_con&mask) == mask;
- break;
- case EX_UFIT:
- mask = 0;
- for (i=leaf2.e_v.e_con;i < 8*sizeof(offset); i++)
- mask |= 1<<i;
- res.e_v.e_con = (leaf1.e_v.e_con&mask) == 0;
- break;
- case EX_ROTATE:
- res.e_v.e_con = rotate(leaf1.e_v.e_con,leaf2.e_v.e_con);
- break;
- }
- return(res);
-}
-
-#ifdef ALLOWSPECIAL
-extern bool special();
-#endif
-
-bool tryrepl(lpp,bp,patlen)
-line_p *lpp;
-register byte *bp;
-int patlen;
-{
- int rpllen,instr,rplval;
- register line_p lp;
- line_p replacement,*rlpp,tp;
-
- rpllen = *bp++&BMASK;
- if (rpllen == BMASK) {
- rpllen = *bp++&BMASK;
- rpllen |= (*bp++&BMASK)<<8;
- }
-#ifdef ALLOWSPECIAL
- if (rpllen == 1 && *bp == 0)
- return(special(lpp,bp+1,patlen));
-#endif
- replacement = (line_p) 0;
- rlpp = &replacement;
- while (rpllen--) {
- instr = *bp++&BMASK;
- rplval = *bp++&BMASK;
- if (rplval == BMASK) {
- rplval = (*bp++&BMASK);
- rplval |= (*bp++&BMASK)<<8;
- }
- if (rplval)
- lp = repline(compute(&enodes[rplval]),patlen);
- else
- lp = newline(OPNO);
-
- /*
- * One replacement instruction is generated,
- * link in list and proceed with the next one.
- */
-
- if (instr == op_lab)
- lp->l_a.la_np->n_line = lp;
- *rlpp = lp;
- rlpp = &lp->l_next;
- lp->l_instr = instr;
- }
-
- /*
- * Replace instructions matched by the created replacement
- */
-
-
- OPTIM((bp[0]&BMASK)|(bp[1]&BMASK)<<8);
- for (lp= *lpp;patlen>0;patlen--,tp=lp,lp=lp->l_next)
- ;
- tp->l_next = (line_p) 0;
- *rlpp = lp;
- lp = *lpp;
- *lpp = replacement;
- while ( lp != (line_p) 0 ) {
- tp = lp->l_next;
- oldline(lp);
- lp = tp;
- }
- return(TRUE);
-}
-
-bool trypat(lpp,bp,len)
-line_p *lpp;
-register byte *bp;
-int len;
-{
- register iarg_p iap;
- int i,patlen;
- register line_p lp;
- eval_t result;
-
- patlen = *bp++&BMASK;
- if (patlen == BMASK) {
- patlen = *bp++&BMASK;
- patlen |= (*bp++&BMASK)<<8;
- }
- if (len == 3) {
- if (patlen<3)
- return(FALSE);
- } else {
- if (patlen != len)
- return(FALSE);
- }
-
- /*
- * Length is ok, now check opcodes
- */
-
- for (i=0,lp= *lpp;i<patlen && lp != (line_p) 0;i++,lp=lp->l_next)
- if (lp->l_instr != *bp++)
- return(FALSE);
- if (i != patlen)
- return(FALSE);
-
- /*
- * opcodes are also correct, now comes the hard part
- */
-
- for(i=0,lp= *lpp,iap= iargs; i<patlen;i++,iap++,lp=lp->l_next) {
- switch(lp->l_optyp) {
- case OPNO:
- iap->ia_ev.e_typ = EV_UNDEF;
- break;
- default:
- iap->ia_ev.e_typ = EV_CONST;
- iap->ia_ev.e_v.e_con = (lp->l_optyp&BMASK)-Z_OPMINI;
- break;
- case OPSHORT:
- iap->ia_ev.e_typ = EV_CONST;
- iap->ia_ev.e_v.e_con = lp->l_a.la_short;
- break;
-#ifdef LONGOFF
- case OPOFFSET:
- iap->ia_ev.e_typ = EV_CONST;
- iap->ia_ev.e_v.e_con = lp->l_a.la_offset;
- break;
-#endif
- case OPNUMLAB:
- iap->ia_ev.e_typ = EV_NUMLAB;
- iap->ia_ev.e_v.e_np = lp->l_a.la_np;
- break;
- case OPSYMBOL:
- iap->ia_ev.e_typ = lp->l_a.la_sp->s_frag;
- iap->ia_sp = lp->l_a.la_sp;
- iap->ia_ev.e_v.e_con = lp->l_a.la_sp->s_value;
- break;
- case OPSVAL:
- iap->ia_ev.e_typ = lp->l_a.la_sval.lasv_sp->s_frag;
- iap->ia_sp = lp->l_a.la_sval.lasv_sp;
- iap->ia_ev.e_v.e_con = lp->l_a.la_sval.lasv_sp->s_value + lp->l_a.la_sval.lasv_short;
- break;
-#ifdef LONGOFF
- case OPLVAL:
- iap->ia_ev.e_typ = lp->l_a.la_lval.lalv_sp->s_frag;
- iap->ia_sp = lp->l_a.la_lval.lalv_sp;
- iap->ia_ev.e_v.e_con = lp->l_a.la_lval.lalv_sp->s_value + lp->l_a.la_lval.lalv_offset;
- break;
-#endif
- }
- }
- i = *bp++&BMASK;
- if ( i==BMASK ) {
- i = *bp++&BMASK;
- i |= (*bp++&BMASK)<<8;
- }
- if ( i != 0) {
- /* there is a condition */
- result = compute(&enodes[i]);
- if (result.e_typ != EV_CONST || result.e_v.e_con == 0)
- return(FALSE);
- }
- return(tryrepl(lpp,bp,patlen));
-}
-
-basicblock(alpp) line_p *alpp; {
- register line_p *lpp,lp;
- bool madeopt;
- unsigned short hash[3];
- line_p *next;
- register byte *bp;
- int i;
- short index;
-
- do { /* make pass over basicblock */
- lpp = alpp; madeopt = FALSE;
- while ((*lpp) != (line_p) 0 && ((*lpp)->l_instr&BMASK) != op_lab) {
- lp = *lpp; next = &lp->l_next;
- hash[0] = lp->l_instr&BMASK;
- lp=lp->l_next;
- if (lp != (line_p) 0) {
- hash[1] = (hash[0]<<4)^(lp->l_instr&BMASK);
- lp=lp->l_next;
- if (lp != (line_p) 0)
- hash[2] = (hash[1]<<4)^(lp->l_instr&BMASK);
- else
- hash[2] = ILLHASH;
- } else {
- hash[1] = ILLHASH;
- hash[2] = ILLHASH;
- }
-
- /*
- * hashvalues computed. Try for longest pattern first
- */
-
- for (i=2;i>=0;i--) {
- index = pathash[hash[i]&BMASK];
- while (index != 0) {
- bp = &pattern[index];
- if((bp[PO_HASH]&BMASK) == (hash[i]>>8))
- if(trypat(lpp,&bp[PO_MATCH],i+1)) {
- madeopt = TRUE;
- next = lpp;
- i = 0; /* dirty way of double break */
- break;
- }
- index=(bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<8);
- }
- }
- lpp = next;
- }
- } while(madeopt); /* as long as there is progress */
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "alloc.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-process() {
-
- if (wordsize == 0 || pointersize == 0)
- error("No MES EMX encountered");
- backward(); /* reverse and cleanup list */
- symknown(); /* symbol scope is now known */
- if (!nflag)
- symvalue(); /* give symbols value */
- if (prodepth != 0) {
- if (!nflag) {
- checklocs(); /* check definition of locals */
- peephole(); /* local optimization */
- relabel(); /* relabel local labels */
- flow(); /* throw away unreachable code */
- }
- outpro(); /* generate PRO pseudo */
- outregs(); /* generate MES ms_reg pseudos */
- }
- putlines(pseudos); /* pseudos first */
- if (prodepth != 0) {
- putlines(instrs); /* instructions next */
- outend(); /* generate END pseudo */
- cleanlocals(); /* forget instruction labels */
- } else if(instrs != (line_p) 0)
- error("instructions outside procedure");
-#ifdef COREDEBUG
- coreverbose();
-#endif
-}
-
-relabel() {
- register num_p *npp,np,tp;
- register num_p repl,ttp;
-
- /*
- * For each label find its final destination after crossjumping.
- * Care has to be taken to prevent a loop in the program to
- * cause same in the optimizer.
- */
-
- for (npp = curpro.numhash; npp < &curpro.numhash[NNUMHASH]; npp++)
- for (np = *npp; np != (num_p) 0; np = np->n_next) {
- assert((np->n_line->l_instr&BMASK) == op_lab
- && np->n_line->l_a.la_np == np);
- for(tp=np; (tp->n_flags&(NUMKNOWN|NUMMARK))==0;
- tp = tp->n_repl)
- tp->n_flags |= NUMMARK;
- repl = tp->n_repl;
- for(tp=np; tp->n_flags&NUMMARK; tp = ttp) {
- ttp = tp->n_repl;
- tp->n_repl = repl;
- tp->n_flags &= ~ NUMMARK;
- tp->n_flags |= NUMKNOWN;
- }
- }
-}
-
-symknown() {
- register sym_p *spp,sp;
-
- for (spp = symhash; spp < &symhash[NSYMHASH]; spp++)
- for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
- sp->s_flags |= SYMKNOWN;
-}
-
-cleanlocals() {
- register num_p *npp,np,tp;
-
- for (npp = curpro.numhash; npp < &curpro.numhash[NNUMHASH]; npp++) {
- np = *npp;
- while (np != (num_p) 0) {
- tp = np->n_next;
- oldnum(np);
- np = tp;
- }
- *npp = (num_p) 0;
- }
-}
-
-checklocs() {
- register num_p *npp,np;
-
- for (npp=curpro.numhash; npp < & curpro.numhash[NNUMHASH]; npp++)
- for (np = *npp; np != (num_p) 0; np=np->n_next)
- if (np->n_line == (line_p) 0)
- error("local label %u undefined",
- (unsigned) np->n_number);
-}
-
-offset align(count,alignment) offset count,alignment; {
-
- assert(alignment==1||alignment==2||alignment==4);
- return((count+alignment-1)&~(alignment-1));
-}
-
-symvalue() {
- register line_p lp;
- register sym_p sp;
- register arg_p ap;
- register argb_p abp;
- short curfrag = 0;
- offset count;
-
- for (lp=pseudos; lp != (line_p) 0; lp = lp->l_next)
- switch(lp->l_instr&BMASK) {
- default:
- assert(FALSE);
- case ps_sym:
- sp = lp->l_a.la_sp;
- if (sp->s_frag != curfrag) {
- count = 0;
- curfrag = sp->s_frag;
- }
- count = align(count,wordsize);
- sp->s_value = count;
- break;
- case ps_bss:
- case ps_hol:
- /* nothing to do, all bss pseudos are in diff frags */
- case ps_mes:
- break;
- case ps_con:
- case ps_rom:
- for (ap=lp->l_a.la_arg; ap != (arg_p) 0; ap = ap->a_next)
- switch(ap->a_typ) {
- default:
- assert(FALSE);
- case ARGOFF:
- count = align(count,wordsize)+wordsize;
- break;
- case ARGNUM:
- case ARGSYM:
- case ARGVAL:
- count = align(count,wordsize)+pointersize;
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- if (ap->a_a.a_con.ac_length < wordsize)
- count = align(count,(offset)ap->a_a.a_con.ac_length);
- else
- count = align(count,wordsize);
- count += ap->a_a.a_con.ac_length;
- break;
- case ARGSTR:
- for (abp = &ap->a_a.a_string; abp != (argb_p) 0;
- abp = abp->ab_next)
- count += abp->ab_index;
- break;
- }
- }
-}
+++ /dev/null
-/* $Header$ */
-
-struct num {
- num_p n_next;
- unsigned n_number;
- unsigned n_jumps;
- num_p n_repl;
- short n_flags;
- line_p n_line;
-};
-
-/* contents of .n_flags */
-#define NUMDATA 000001
-#define NUMREACH 000002
-#define NUMKNOWN 000004
-#define NUMMARK 000010
-#define NUMSCAN 000020
-
-#define NNUMHASH 37
-extern num_p numlookup();
-
-struct regs {
- reg_p r_next;
- offset r_par[4];
-};
-
-typedef struct proinf {
- offset localbytes;
- line_p lastline;
- sym_p symbol;
- reg_p freg;
- bool gtoproc;
- num_p numhash[NNUMHASH];
-} proinf;
-
-extern proinf curpro;
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_mnem.h"
-#include "../../h/em_flag.h"
-#include "alloc.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define outbyte(b) putc(b,outfile)
-
-putlines(lnp) register line_p lnp; {
- register arg_p ap;
- line_p temp;
- register instr;
- short curlin= -2;
- short thislin;
-
- while ( lnp != (line_p) 0) {
- instr = lnp->l_instr&BMASK;
- switch(lnp->l_optyp) {
- case OPSYMBOL:
- if ((lnp->l_instr&BMASK) == ps_sym)
- outdef(lnp->l_a.la_sp);
- else
- outocc(lnp->l_a.la_sp);
- break;
- case OPSVAL:
- outocc(lnp->l_a.la_sval.lasv_sp);
- break;
-#ifdef LONGOFF
- case OPLVAL:
- outocc(lnp->l_a.la_lval.lalv_sp);
- break;
-#endif
- case OPLIST:
- ap = lnp->l_a.la_arg;
- while (ap != (arg_p) 0) {
- switch(ap->a_typ) {
- case ARGSYM:
- outocc(ap->a_a.a_sp);
- break;
- case ARGVAL:
- outocc(ap->a_a.a_val.av_sp);
- break;
- }
- ap = ap->a_next;
- }
- break;
- }
-
- /*
- * global symbols now taken care of
- */
-
-
- switch(instr) {
- case ps_sym:
- break;
- case op_lni:
- if (curlin != -2)
- curlin++;
- outinst(instr);
- break;
- case op_lin:
- switch(lnp->l_optyp) {
- case OPNO:
- case OPOFFSET:
- case OPNUMLAB:
- case OPSYMBOL:
- case OPSVAL:
- case OPLVAL:
- case OPLIST:
- outinst(instr);
- goto processoperand;
- case OPSHORT:
- thislin = lnp->l_a.la_short;
- break;
- default:
- thislin = (lnp->l_optyp&BMASK)-Z_OPMINI;
- break;
- }
- if (thislin == curlin && !nflag) {
- temp = lnp->l_next;
- oldline(lnp);
- lnp = temp;
- OPTIM(O_LINGONE);
- continue;
- } else if (thislin == curlin+1 && !nflag) {
- instr = op_lni;
- outinst(instr);
- temp = lnp->l_next;
- oldline(lnp);
- OPTIM(O_LINLNI);
- lnp = newline(OPNO);
- lnp->l_next = temp;
- lnp->l_instr = instr;
- } else {
- outinst(instr);
- }
- curlin = thislin;
- break;
- case op_lab:
- curlin = -2;
- break;
- default:
- outinst(instr);
- }
-processoperand:
- switch(lnp->l_optyp) {
- case OPNO:
- if ((em_flag[instr-sp_fmnem]&EM_PAR)!=PAR_NO)
- outbyte( (byte) sp_cend) ;
- break;
- default:
- outint((lnp->l_optyp&BMASK)-Z_OPMINI);
- break;
- case OPSHORT:
- outint(lnp->l_a.la_short);
- break;
-#ifdef LONGOFF
- case OPOFFSET:
- outoff(lnp->l_a.la_offset);
- break;
-#endif
- case OPNUMLAB:
- if (instr == op_lab)
- numlab(lnp->l_a.la_np->n_repl);
- else if (instr < sp_fpseu) /* plain instruction */
- outint((short) lnp->l_a.la_np->n_repl->n_number);
- else
- outnum(lnp->l_a.la_np->n_repl);
- break;
- case OPSYMBOL:
- outsym(lnp->l_a.la_sp);
- break;
- case OPSVAL:
- outbyte( (byte) sp_doff) ;
- outsym(lnp->l_a.la_sval.lasv_sp);
- outint(lnp->l_a.la_sval.lasv_short);
- break;
-#ifdef LONGOFF
- case OPLVAL:
- outbyte( (byte) sp_doff) ;
- outsym(lnp->l_a.la_lval.lalv_sp);
- outoff(lnp->l_a.la_lval.lalv_offset);
- break;
-#endif
- case OPLIST:
- putargs(lnp->l_a.la_arg);
- switch(instr) {
- case ps_con:
- case ps_rom:
- case ps_mes:
- outbyte( (byte) sp_cend) ;
- }
- }
- /*
- * instruction is output now.
- * remove its useless body
- */
-
- temp = lnp->l_next;
- oldline(lnp);
- lnp = temp;
- if (ferror(outfile))
- error("write error");
- }
-}
-
-putargs(ap) register arg_p ap; {
-
- while (ap != (arg_p) 0) {
- switch(ap->a_typ) {
- default:
- assert(FALSE);
- case ARGOFF:
- outoff(ap->a_a.a_offset);
- break;
- case ARGNUM:
- outnum(ap->a_a.a_np->n_repl);
- break;
- case ARGSYM:
- outsym(ap->a_a.a_sp);
- break;
- case ARGVAL:
- outbyte( (byte) sp_doff) ;
- outsym(ap->a_a.a_val.av_sp);
- outoff(ap->a_a.a_val.av_offset);
- break;
- case ARGSTR:
- outbyte( (byte) sp_scon) ;
- putstr(&ap->a_a.a_string);
- break;
- case ARGICN:
- outbyte( (byte) sp_icon) ;
- goto casecon;
- case ARGUCN:
- outbyte( (byte) sp_ucon) ;
- goto casecon;
- case ARGFCN:
- outbyte( (byte) sp_fcon) ;
- casecon:
- outint(ap->a_a.a_con.ac_length);
- putstr(&ap->a_a.a_con.ac_con);
- break;
- }
- ap = ap->a_next;
- }
-}
-
-putstr(abp) register argb_p abp; {
- register argb_p tbp;
- register length;
-
- length = 0;
- tbp = abp;
- while (tbp!= (argb_p) 0) {
- length += tbp->ab_index;
- tbp = tbp->ab_next;
- }
- outint(length);
- while (abp != (argb_p) 0) {
- for (length=0;length<abp->ab_index;length++)
- outbyte( (byte) abp->ab_contents[length] );
- abp = abp->ab_next;
- }
-}
-
-outdef(sp) register sym_p sp; {
-
- /*
- * The surrounding If statement is removed to be friendly
- * to Backend writers having to deal with assemblers
- * not following our conventions.
- if ((sp->s_flags&SYMOUT)==0) {
- */
- sp->s_flags |= SYMOUT;
- if (sp->s_flags&SYMGLOBAL) {
- outinst(sp->s_flags&SYMPRO ? ps_exp : ps_exa);
- outsym(sp);
- }
- /*
- }
- */
-}
-
-outocc(sp) register sym_p sp; {
-
- if ((sp->s_flags&SYMOUT)==0) {
- sp->s_flags |= SYMOUT;
- if ((sp->s_flags&SYMGLOBAL)==0) {
- outinst(sp->s_flags&SYMPRO ? ps_inp : ps_ina);
- outsym(sp);
- }
- }
-}
-
-outpro() {
-
- outdef(curpro.symbol);
- outinst(ps_pro);
- outsym(curpro.symbol);
- outoff(curpro.localbytes);
-}
-
-outend() {
-
- outinst(ps_end);
- outoff(curpro.localbytes);
-}
-
-outinst(m) {
-
- outbyte( (byte) m );
-}
-
-outoff(off) offset off; {
-
-#ifdef LONGOFF
- if ((short) off == off)
-#endif
- outint((short) off);
-#ifdef LONGOFF
- else {
- outbyte( (byte) sp_cst4) ;
- outshort( (short) (off&0177777L) );
- outshort( (short) (off>>16) );
- }
-#endif
-}
-
-outint(i) short i; {
-
- if (i>= -sp_zcst0 && i< sp_ncst0-sp_zcst0)
- outbyte( (byte) (i+sp_zcst0+sp_fcst0) );
- else {
- outbyte( (byte) sp_cst2) ;
- outshort(i);
- }
-}
-
-outshort(i) short i; {
-
- outbyte( (byte) (i&BMASK) );
- outbyte( (byte) (i>>8) );
-}
-
-numlab(np) register num_p np; {
-
- if (np->n_number < sp_nilb0)
- outbyte( (byte) (np->n_number + sp_filb0) );
- else
- outnum(np);
-}
-
-outnum(np) register num_p np; {
-
- if(np->n_number<256) {
- outbyte( (byte) sp_ilb1) ;
- outbyte( (byte) (np->n_number) );
- } else {
- outbyte( (byte) sp_ilb2) ;
- outshort((short) np->n_number);
- }
-}
-
-outsym(sp) register sym_p sp; {
- register byte *p;
- register unsigned num;
-
- if (sp->s_name[0] == '.') {
- num = atoi(&sp->s_name[1]);
- if (num < 256) {
- outbyte( (byte) sp_dlb1) ;
- outbyte( (byte) (num) );
- } else {
- outbyte( (byte) sp_dlb2) ;
- outshort((short) num);
- }
- } else {
- p= sp->s_name;
- while (*p && p < &sp->s_name[IDL])
- p++;
- num = p - sp->s_name;
- outbyte( (byte) (sp->s_flags&SYMPRO ? sp_pnam : sp_dnam) );
- outint((short) num);
- p = sp->s_name;
- while (num--)
- outbyte( (byte) *p++ );
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "types.h"
-#include "line.h"
-#include "proinf.h"
-#include "alloc.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_mes.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-regvar(ap) register arg_p ap; {
- register reg_p rp;
- register i;
-
- rp = newreg();
- i=0;
- while (ap!=(arg_p)0 && ap->a_typ==ARGOFF && i<4) {
- rp->r_par[i++]=ap->a_a.a_offset;
- ap=ap->a_next;
- }
- /*
- * Omit incomplete messages
- */
- switch(i) {
- default:assert(FALSE);
- case 0:
- case 1:
- case 2: oldreg(rp); return;
- case 3: rp->r_par[3]= (offset) 0; break;
- case 4: break;
- }
- rp->r_next = curpro.freg;
- curpro.freg = rp;
-}
-
-inreg(off) offset off; {
- register reg_p rp;
-
- for (rp=curpro.freg; rp != (reg_p) 0; rp=rp->r_next)
- if( rp->r_par[0] == off)
- return(TRUE);
- return(FALSE);
-}
-
-outregs() {
- register reg_p rp,tp;
- register i;
-
- for(rp=curpro.freg; rp != (reg_p) 0; rp = tp) {
- tp = rp->r_next;
- if (rp->r_par[3] != 0) {
- outinst(ps_mes);
- outoff((offset)ms_reg);
- for(i=0;i<4;i++)
- outoff(rp->r_par[i]);
- outinst(sp_cend);
- }
- oldreg(rp);
- }
- /* List of register messages is followed by an empty ms_reg
- * unless an ms_gto was in this procedure, then the ms_gto
- * will be output. Kludgy.
- */
- outinst(ps_mes);
- outoff((offset)(curpro.gtoproc? ms_gto : ms_reg));
- outinst(sp_cend);
- curpro.freg = (reg_p) 0;
-}
-
-incregusage(off) offset off; {
- register reg_p rp;
-
- for(rp=curpro.freg; rp != (reg_p) 0; rp=rp->r_next)
- if (rp->r_par[0]==off) {
- rp->r_par[3]++;
- return;
- }
-}
+++ /dev/null
-%{
-#ifndef NORCSID
-static char rcsid2[] = "$Header$";
-#endif
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern long atol();
-%}
-%%
-notreg return(NOTREG);
-sfit return(SFIT);
-ufit return(UFIT);
-rotate return(ROTATE);
-p return(PSIZE);
-w return(WSIZE);
-defined return(DEFINED);
-samesign return(SAMESIGN);
-rom return(ROM);
-[a-zA-Z]{3} {
- int m;
- m = mlookup(yytext);
- if (m==0) {
- REJECT;
- } else {
- yylval.y_int = m;
- return(MNEM);
- }
- }
-"&&" return(AND2);
-"||" return(OR2);
-"&" return(AND1);
-"|" return(OR1);
-"^" return(XOR1);
-"+" return(ARPLUS);
-"-" return(ARMINUS);
-"*" return(ARTIMES);
-"/" return(ARDIVIDE);
-"%" return(ARMOD);
-"==" return(CMPEQ);
-"!=" return(CMPNE);
-"<" return(CMPLT);
-"<=" return(CMPLE);
-">" return(CMPGT);
-">=" return(CMPGE);
-"!" return(NOT);
-"~" return(COMP);
-"<<" return(LSHIFT);
-">>" return(RSHIFT);
-[0-9]+ { long l= atol(yytext);
- if (l>32767) yyerror("Number too big");
- yylval.y_int= (int) l;
- return(NUMBER);
- }
-[ \t] ;
-. return(yytext[0]);
-\n { lino++; return(yytext[0]); }
-:[ \t]*\n[ \t]+ { lino++; return(':'); }
-^"# "[0-9]+.*\n { lino=atoi(yytext+2); }
-^\#.*\n { lino++; }
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-bool special(lpp,bp,patlen)
-line_p *lpp;
-byte *bp;
-int patlen;
-{
-
- return(FALSE);
-}
+++ /dev/null
-: '$Header$'
-while true
-do
- (echo ' mes 2,2,2
- pro $foo,0';cat;echo ' end') >t.e
- npc -2=${1-opt} -O -2 t.e;npc -D t.m
- cat t.e
-done
+++ /dev/null
-/* $Header$ */
-
-typedef char byte;
-typedef char bool;
-typedef struct line line_t;
-typedef struct line *line_p;
-typedef struct sym sym_t;
-typedef struct sym *sym_p;
-typedef struct num num_t;
-typedef struct num *num_p;
-typedef struct arg arg_t;
-typedef struct arg *arg_p;
-typedef struct argbytes argb_t;
-typedef struct argbytes *argb_p;
-typedef struct regs reg_t;
-typedef struct regs *reg_p;
-#ifdef LONGOFF
-typedef long offset;
-#else
-typedef short offset;
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-
-/* VARARGS1 */
-error(s,a) char *s,*a; {
-
- fprintf(stderr,"%s: error on line %u",progname,linecount);
- if (prodepth != 0)
- fprintf(stderr,"(%.*s)",IDL,curpro.symbol->s_name);
- fprintf(stderr,": ");
- fprintf(stderr,s,a);
- fprintf(stderr,"\n");
- abort();
- exit(-1);
-}
-
-#ifndef NDEBUG
-badassertion(file,line) char *file; unsigned line; {
-
- fprintf(stderr,"assertion failed file %s, line %u\n",file,line);
- error("assertion");
-}
-#endif
-
-#ifdef DIAGOPT
-optim(n) {
-
- fprintf(stderr,"Made optimization %d",n);
- if (inpro)
- fprintf(stderr," (%.*s)",IDL,curpro.symbol->s_name);
- fprintf(stderr,"\n");
-}
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "lookup.h"
-#include "proinf.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-unsigned linecount = 0; /* "line"number for errormessages */
-int prodepth = 0; /* Level of nesting */
-bool Lflag = 0; /* make library module */
-bool nflag = 0; /* do not optimize */
-line_p instrs,pseudos; /* pointers to chains */
-sym_p symhash[NSYMHASH]; /* array of pointers to chains */
-FILE *outfile;
-char template[] = "/usr/tmp/emoptXXXXXX";
-offset wordsize = 0;
-offset pointersize = 0;
-char *progname;
-proinf curpro; /* collected information about current pro */
public / ack.git / commitdiff