diff --git a/lang/pc/pem/Makefile b/lang/pc/pem/Makefile new file mode 100644 index 00000000..1293ea31 --- /dev/null +++ b/lang/pc/pem/Makefile @@ -0,0 +1,44 @@ +# $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 diff --git a/lang/pc/pem/move.c b/lang/pc/pem/move.c new file mode 100644 index 00000000..b2c32ce1 --- /dev/null +++ b/lang/pc/pem/move.c @@ -0,0 +1,20 @@ +/* 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) ; +} diff --git a/lang/pc/pem/pem.p b/lang/pc/pem/pem.p new file mode 100644 index 00000000..ccd399a4 --- /dev/null +++ b/lang/pc/pem/pem.p @@ -0,0 +1,3138 @@ +#include +#include +#include +#include +#include +#include + +{ + (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 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 isp_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 isource; 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 kdigit; + {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 (min2max1) 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 (lvalmax) 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>>>>>>>>>>>} + 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 inil 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 argcmaxargc 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 ixoff 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} diff --git a/lib/6500/descr b/lib/6500/descr new file mode 100644 index 00000000..1e50c6ee --- /dev/null +++ b/lib/6500/descr @@ -0,0 +1,27 @@ +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 -I/usr/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 diff --git a/lib/6809/descr b/lib/6809/descr new file mode 100644 index 00000000..683a21ec --- /dev/null +++ b/lib/6809/descr @@ -0,0 +1,31 @@ +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 -I/usr/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 diff --git a/lib/descr/cpm b/lib/descr/cpm new file mode 100644 index 00000000..afa4cc9d --- /dev/null +++ b/lib/descr/cpm @@ -0,0 +1,25 @@ +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 -I/usr/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 diff --git a/lib/descr/fe.src b/lib/descr/fe.src new file mode 100644 index 00000000..a72a363c --- /dev/null +++ b/lib/descr/fe.src @@ -0,0 +1,60 @@ +# (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.new + 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 diff --git a/lib/descr/ibm.nosid b/lib/descr/ibm.nosid new file mode 100644 index 00000000..c3db4db0 --- /dev/null +++ b/lib/descr/ibm.nosid @@ -0,0 +1,35 @@ +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 LIBIBM=mach/ibm/lib/tail_ +var RT=mach/i86/lib/head_ +var RTIBM=mach/ibm/lib/head_ +var INCLUDES=-I{EM}/include -I{EM}/mach/ibm/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}/{RTIBM}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}/{LIBIBM}em) \ +(.c.p:{TAIL}={EM}/{LIBIBM}mon) \ +(.e:{TAIL}={EM}/{LIBIBM}em.vend) + prop C +end diff --git a/lib/descr/m68k2.macs b/lib/descr/m68k2.macs new file mode 100644 index 00000000..58bdc46e --- /dev/null +++ b/lib/descr/m68k2.macs @@ -0,0 +1,34 @@ +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 LIBDIR=mach/m68k2/lib +var LIB=mach/m68k2/lib/tail_ +var RT=mach/m68k2/lib/head_ +var INCLUDES=-I{EM}/include -I/usr/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 diff --git a/lib/descr/nascom b/lib/descr/nascom new file mode 100644 index 00000000..117911d7 --- /dev/null +++ b/lib/descr/nascom @@ -0,0 +1,28 @@ +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 -I/usr/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 diff --git a/lib/descr/net86 b/lib/descr/net86 new file mode 100644 index 00000000..27097aed --- /dev/null +++ b/lib/descr/net86 @@ -0,0 +1,32 @@ +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 -I/usr/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}netio) (.c.p.e:{TAIL}={EM}/{LIB}alo) \ +(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em) + prop C +end diff --git a/lib/descr/sat86 b/lib/descr/sat86 new file mode 100644 index 00000000..0e3a8e57 --- /dev/null +++ b/lib/descr/sat86 @@ -0,0 +1,33 @@ +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 ALIB=mach/i86/lib/sat_tail_ +var RT=mach/i86/lib/head_ +var ART=mach/i86/lib/sat_head_ +var INCLUDES=-I{EM}/include -I/usr/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}/{ART}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}/{ALIB}mon) (.c.p.e:{TAIL}={EM}/{LIB}alo) \ +(.e:{TAIL}={EM}/{LIB}em) + prop C +end diff --git a/lib/em22/descr b/lib/em22/descr new file mode 100644 index 00000000..dd468fba --- /dev/null +++ b/lib/em22/descr @@ -0,0 +1,27 @@ +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 -I/usr/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 diff --git a/lib/i80/descr b/lib/i80/descr new file mode 100644 index 00000000..3c0ea492 --- /dev/null +++ b/lib/i80/descr @@ -0,0 +1,27 @@ +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 -I/usr/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 diff --git a/lib/i86/descr b/lib/i86/descr new file mode 100644 index 00000000..4bea559d --- /dev/null +++ b/lib/i86/descr @@ -0,0 +1,32 @@ +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 -I/usr/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 diff --git a/lib/m68k2/descr b/lib/m68k2/descr new file mode 100644 index 00000000..bafd025e --- /dev/null +++ b/lib/m68k2/descr @@ -0,0 +1,30 @@ +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 -I/usr/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 diff --git a/lib/m68k4/descr b/lib/m68k4/descr new file mode 100644 index 00000000..db0b1c0d --- /dev/null +++ b/lib/m68k4/descr @@ -0,0 +1,34 @@ +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 -I/usr/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 diff --git a/lib/pdp/descr b/lib/pdp/descr new file mode 100644 index 00000000..eb99a54a --- /dev/null +++ b/lib/pdp/descr @@ -0,0 +1,38 @@ +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 -I/usr/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 diff --git a/lib/pmds/descr b/lib/pmds/descr new file mode 100644 index 00000000..d602a1d6 --- /dev/null +++ b/lib/pmds/descr @@ -0,0 +1,32 @@ +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 -I/usr/include +name be + from .m + to .o + program {EM}/lib/{M}_cg + args < + prop > + need .e +end +name asld + from .o.s.a + to a.out + program {EM}/lib/{M}_as + mapflag -l* LNAME={EM}/{LIB}* + mapflag -i + mapflag -n + args (.e:{HEAD}={EM}/{RT}em.pmds) \ +({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.pmds {EM}/{LIB}em.vend) + prop Cm +end diff --git a/lib/vax4/descr.src b/lib/vax4/descr.src new file mode 100644 index 00000000..bd5f77d0 --- /dev/null +++ b/lib/vax4/descr.src @@ -0,0 +1,44 @@ +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 -I/usr/include +name be + from .m + to .s + program {EM}/lib/{M}_cg + args < + prop > + need .e +end +name asopt + from .s + to .so + program /bin/sed + args -f {EM}/mach/vax4/cg/sedf + prop O<> +end +name as + from .s.so + 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) \ +(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em) + prop C +end diff --git a/lib/z80/descr b/lib/z80/descr new file mode 100644 index 00000000..37a362e9 --- /dev/null +++ b/lib/z80/descr @@ -0,0 +1,31 @@ +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 -I/usr/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) \ +(.p.c:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em) + prop C +end diff --git a/lib/z8000/descr b/lib/z8000/descr new file mode 100644 index 00000000..823c4638 --- /dev/null +++ b/lib/z8000/descr @@ -0,0 +1,31 @@ +var w=2 +var p=2 +var s=2 +var l=4 +var f=4 +var d=8 +var NAME=z8000 +var M=z8000 +var LIB=mach/z8000/lib/tail_ +var RT=mach/z8000/lib/head_ +var INCLUDES=-I{EM}/include -I/usr/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) \ +(.p.c:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em) + prop C +end diff --git a/mach/6500/cg/Makefile b/mach/6500/cg/Makefile new file mode 100644 index 00000000..522d02ad --- /dev/null +++ b/mach/6500/cg/Makefile @@ -0,0 +1,178 @@ +# $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 diff --git a/mach/pdp/cg/Makefile b/mach/pdp/cg/Makefile new file mode 100644 index 00000000..522d02ad --- /dev/null +++ b/mach/pdp/cg/Makefile @@ -0,0 +1,178 @@ +# $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 diff --git a/mach/pdp/cg/mach.c b/mach/pdp/cg/mach.c new file mode 100644 index 00000000..cd33ca5d --- /dev/null +++ b/mach/pdp/cg/mach.c @@ -0,0 +1,171 @@ +#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)+24 * + * * + * 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" ) diff --git a/mach/proto/cg/Makefile b/mach/proto/cg/Makefile new file mode 100644 index 00000000..522d02ad --- /dev/null +++ b/mach/proto/cg/Makefile @@ -0,0 +1,178 @@ +# $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 diff --git a/mach/proto/cg/assert.h b/mach/proto/cg/assert.h new file mode 100644 index 00000000..3cc93b88 --- /dev/null +++ b/mach/proto/cg/assert.h @@ -0,0 +1,7 @@ +/* $Header$ */ + +#ifndef NDEBUG +#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__) +#else +#define assert(x) /* nothing */ +#endif diff --git a/mach/proto/cg/codegen.c b/mach/proto/cg/codegen.c new file mode 100644 index 00000000..8c4fb6f0 --- /dev/null +++ b/mach/proto/cg/codegen.c @@ -0,0 +1,672 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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 +#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;i1) { + /* + * More than 1 tokenpattern is a candidate. + * Decision has to be made by lookahead. + */ + SAVEST; + mincost = costlimit-totalcost+1; + for(i=0;icostlimit) { + 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>5)&07; + for(i=0;i=fakestack) { + size=tsize(tp); + while (i= 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=fakestack) { + if (!match(tp,&machsets[tokexp[i]],0)) { + cp = findcoerc(tp, &machsets[tokexp[i]]); + if (cp==0) { + for (j=0;jc3_prop==0) { + totalcost+=docoerc(tp,cp,ply,toplevel,0); + CHKCOST(); + } else { + assert(nregneededstackheight) { + stackpad = tokpatlen-stackheight; + for (j=stackheight-1;j>=0;j--) + fakestack[j+stackpad] = fakestack[j]; + for (j=0;j=fakestack) { + cp = findcoerc((token_p) 0, &machsets[tokexp[i]]); + if (cp==0) { + assert(!toplevel); + for (j=0;jc3_prop==0) { + totalcost+=docoerc(tp,cp,ply,toplevel,0); + CHKCOST(); + } else { + assert(nregneededp_next; + for (i=0,t=0;ip_rar[i]); + if (tcostlimit) { + if (besttup) + myfree(besttup); + if (stackpad!=tokpatlen) { + if (stackpad) { + if (costlimitp_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;rpr_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;it_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;it_type[i]==EV_REG) + chrefcount(token.t_att[i].ar,-1,TRUE); + } + break; + case DO_REALLOCATE: + DEBUG("REALLOCATE"); + for(rp=machregs;rpr_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;icostlimit) { + 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>5)&07; + j=emp-emlines; + if (emrepllen>j) { + assert(nemlines+emrepllen-j=0;i--) + emlines[i+emrepllen-j] = emlines[i]; + nemlines += emrepllen-j; + emp += emrepllen-j; + } + emp -= emrepllen; + for (i=0;i +#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;iex_rnode>=0 &&node->ex_rnodeex_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<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_conex_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); + } +} diff --git a/mach/proto/cg/data.h b/mach/proto/cg/data.h new file mode 100644 index 00000000..ecfe7f67 --- /dev/null +++ b/mach/proto/cg/data.h @@ -0,0 +1,54 @@ +/* $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; diff --git a/mach/proto/cg/equiv.c b/mach/proto/cg/equiv.c new file mode 100644 index 00000000..0e677d37 --- /dev/null +++ b/mach/proto/cg/equiv.c @@ -0,0 +1,105 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "equiv.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;ip_next) { + for (i=0; ip_rar[i]]) + goto diff; + for (i=0; ip_rar[i],pp->p_rar[j])) + goto diff; + return; + diff: ; + } + pp = (struct perm *) myalloc(sizeof ( *pp )); + pp->p_next = perms; + for (i=0; ip_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); + } + } +} diff --git a/mach/proto/cg/equiv.h b/mach/proto/cg/equiv.h new file mode 100644 index 00000000..f1dc6c85 --- /dev/null +++ b/mach/proto/cg/equiv.h @@ -0,0 +1,8 @@ +/* $Header$ */ + +#define MAXCREG 4 + +struct perm { + struct perm *p_next; + int p_rar[MAXCREG]; +}; diff --git a/mach/proto/cg/extern.h b/mach/proto/cg/extern.h new file mode 100644 index 00000000..5e84bf52 --- /dev/null +++ b/mach/proto/cg/extern.h @@ -0,0 +1,49 @@ +/* $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 diff --git a/mach/proto/cg/fillem.c b/mach/proto/cg/fillem.c new file mode 100644 index 00000000..b3856fa9 --- /dev/null +++ b/mach/proto/cg/fillem.c @@ -0,0 +1,644 @@ +#ifndef NORCSID +static char rcsid2[] = "$Header$"; +#endif + +#include +#include "assert.h" +#include +#include +#include +#include +#include +#include "mach.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#include "data.h" +#include "result.h" +#ifdef REGVARS +#include "regvar.h" +#include +#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)-empem_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= 0) + r_off += EM_BSIZE; +#endif + getarg(ptyp(sp_cst2)); + r_size = argval; + getarg(ptyp(sp_cst2)); + r_type = argval; + if (r_typereg_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" diff --git a/mach/proto/cg/gencode.c b/mach/proto/cg/gencode.c new file mode 100644 index 00000000..ea1ccbe5 --- /dev/null +++ b/mach/proto/cg/gencode.c @@ -0,0 +1,194 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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].art_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; + } + } + } +} diff --git a/mach/proto/cg/glosym.c b/mach/proto/cg/glosym.c new file mode 100644 index 00000000..cf8f0297 --- /dev/null +++ b/mach/proto/cg/glosym.c @@ -0,0 +1,52 @@ +#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); +} diff --git a/mach/proto/cg/glosym.h b/mach/proto/cg/glosym.h new file mode 100644 index 00000000..7fb4c7cf --- /dev/null +++ b/mach/proto/cg/glosym.h @@ -0,0 +1,9 @@ +/* $Header$ */ + +typedef struct glosym { + struct glosym *gl_next; + string gl_name; + word gl_rom[MAXROM+1]; +} glosym_t,*glosym_p; + +glosym_p lookglo(); diff --git a/mach/proto/cg/main.c b/mach/proto/cg/main.c new file mode 100644 index 00000000..08d5c46c --- /dev/null +++ b/mach/proto/cg/main.c @@ -0,0 +1,84 @@ +#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); +} diff --git a/mach/proto/cg/move.c b/mach/proto/cg/move.c new file mode 100644 index 00000000..b74e5508 --- /dev/null +++ b/mach/proto/cg/move.c @@ -0,0 +1,110 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;rpr_contents.t_token == 0) + continue; + assert(rp->r_contents.t_token > 0); + tdp = &tokens[rp->r_contents.t_token]; + for (i=0;it_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;mpm_set1],mp->m_expr1)) + continue; + if (match(tp2,&machsets[mp->m_set2],mp->m_expr2)) + break; + /* + * Correct move rule is found + */ + } + assert(mpm_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); +} diff --git a/mach/proto/cg/nextem.c b/mach/proto/cg/nextem.c new file mode 100644 index 00000000..4aab43f2 --- /dev/null +++ b/mach/proto/cg/nextem.c @@ -0,0 +1,131 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#include +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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 +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;iemlines) { + nemlines -= emp-emlines; + for (i=0,ep=emlines;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); +} diff --git a/mach/proto/cg/param.h b/mach/proto/cg/param.h new file mode 100644 index 00000000..24326015 --- /dev/null +++ b/mach/proto/cg/param.h @@ -0,0 +1,19 @@ +/* $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 diff --git a/mach/proto/cg/reg.c b/mach/proto/cg/reg.c new file mode 100644 index 00000000..4482dce1 --- /dev/null +++ b/mach/proto/cg/reg.c @@ -0,0 +1,175 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;ir_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;ir_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;rpr_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;ir_contents.t_att[i].aw = 0; + + /* Now erase recursively all registers containing + * something using this one + */ + for (rp=machregs;rpr_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;it_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;rpr_contents.t_token = 0; + for (i=0;ir_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;ir_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;rpr_tcount==0); + } + for (tp=fakestack;tpt_token == -1) + inctcount(tp->t_att[0].ar); + else { + tdp = &tokens[tp->t_token]; + for (i=0;it_type[i]==EV_REG) + inctcount(tp->t_att[i].ar); + } + } +#ifdef REGVARS +#include + for(i=reg_any;i<=reg_float;i++) { + int j; + for(j=0;jr_refcount==rp->r_tcount); + rp->r_tcount=0; + } +} +#endif diff --git a/mach/proto/cg/regvar.c b/mach/proto/cg/regvar.c new file mode 100644 index 00000000..6379b9bc --- /dev/null +++ b/mach/proto/cg/regvar.c @@ -0,0 +1,151 @@ +#include "assert.h" +#include "param.h" +#include "tables.h" + +#ifdef REGVARS + +#include "types.h" +#include +#include "data.h" +#include "regvar.h" +#include +#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_scorerv_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_scorer_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;ira_rv = 0; + ra->ra_score = 0; + } + } +} + +#endif REGVARS + +/* nothing after this */ diff --git a/mach/proto/cg/regvar.h b/mach/proto/cg/regvar.h new file mode 100644 index 00000000..716a68f2 --- /dev/null +++ b/mach/proto/cg/regvar.h @@ -0,0 +1,19 @@ +/* $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[]; diff --git a/mach/proto/cg/result.h b/mach/proto/cg/result.h new file mode 100644 index 00000000..e4fa6299 --- /dev/null +++ b/mach/proto/cg/result.h @@ -0,0 +1,19 @@ +/* $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(); diff --git a/mach/proto/cg/salloc.c b/mach/proto/cg/salloc.c new file mode 100644 index 00000000..0543c96a --- /dev/null +++ b/mach/proto/cg/salloc.c @@ -0,0 +1,150 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;iem_soper,used); + for (tp= fakestack;tp<&fakestack[stackheight];tp++) { + if (tp->t_token== -1) + continue; + tdp = &tokens[tp->t_token]; + for (i=0;it_type[i] == EV_STR) + chkstr(tp->t_att[i].as,used); + } + for (rp= machregs; rpr_contents; + assert(tp->t_token != -1); + tdp= &tokens[tp->t_token]; + for (i=0;it_type[i] == EV_STR) + chkstr(tp->t_att[i].as,used); + } + for (i=0;ilow) { + middle= (low+high)>>1; + if (str==stab[middle]) { + used[middle]=1; + return; + } + if (str +#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); +} diff --git a/mach/proto/cg/state.h b/mach/proto/cg/state.h new file mode 100644 index 00000000..82041690 --- /dev/null +++ b/mach/proto/cg/state.h @@ -0,0 +1,24 @@ +/* $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 diff --git a/mach/proto/cg/subr.c b/mach/proto/cg/subr.c new file mode 100644 index 00000000..90f0add9 --- /dev/null +++ b/mach/proto/cg/subr.c @@ -0,0 +1,547 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;it_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;iin_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;iin_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;it_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;itoksize) + return(100); + if (expsizet_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;it_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 && ic2_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-1c2_codep],ply,toplevel,MAXINT,0); + tokpatlen = tpl; + for (i=0;ic2_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;ic1_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;ic1_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;ic3_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); +} diff --git a/mach/proto/cg/types.h b/mach/proto/cg/types.h new file mode 100644 index 00000000..2c15ac0d --- /dev/null +++ b/mach/proto/cg/types.h @@ -0,0 +1,33 @@ +/* $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 diff --git a/mach/proto/cg/var.c b/mach/proto/cg/var.c new file mode 100644 index 00000000..48de9ba1 --- /dev/null +++ b/mach/proto/cg/var.c @@ -0,0 +1,41 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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; diff --git a/mach/vax4/cg/Makefile b/mach/vax4/cg/Makefile new file mode 100644 index 00000000..522d02ad --- /dev/null +++ b/mach/vax4/cg/Makefile @@ -0,0 +1,178 @@ +# $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 diff --git a/mach/z80/cg/Makefile b/mach/z80/cg/Makefile new file mode 100644 index 00000000..522d02ad --- /dev/null +++ b/mach/z80/cg/Makefile @@ -0,0 +1,178 @@ +# $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 diff --git a/mach/z8000/cg/Makefile b/mach/z8000/cg/Makefile new file mode 100644 index 00000000..522d02ad --- /dev/null +++ b/mach/z8000/cg/Makefile @@ -0,0 +1,178 @@ +# $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 diff --git a/util/ack/.distr b/util/ack/.distr new file mode 100644 index 00000000..83d135be --- /dev/null +++ b/util/ack/.distr @@ -0,0 +1,23 @@ +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 diff --git a/util/ack/Makefile b/util/ack/Makefile new file mode 100644 index 00000000..3b985e7d --- /dev/null +++ b/util/ack/Makefile @@ -0,0 +1,63 @@ +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) diff --git a/util/ack/ack.h b/util/ack/ack.h new file mode 100644 index 00000000..b084a647 --- /dev/null +++ b/util/ack/ack.h @@ -0,0 +1,88 @@ +/****************************************************************************/ +/* 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 diff --git a/util/ack/data.c b/util/ack/data.c new file mode 100644 index 00000000..b92fc8bd --- /dev/null +++ b/util/ack/data.c @@ -0,0 +1,9 @@ +#include "ack.h" +#include "list.h" +#include "trans.h" + + +#undef EXTERN +#define EXTERN + +#include "data.h" diff --git a/util/ack/data.h b/util/ack/data.h new file mode 100644 index 00000000..23af80c5 --- /dev/null +++ b/util/ack/data.h @@ -0,0 +1,43 @@ +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 */ diff --git a/util/ack/dmach.h b/util/ack/dmach.h new file mode 100644 index 00000000..1e7880ad --- /dev/null +++ b/util/ack/dmach.h @@ -0,0 +1,15 @@ +/***************************************************************/ +/* */ +/* 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[] ; diff --git a/util/ack/files.c b/util/ack/files.c new file mode 100644 index 00000000..83f14cd9 --- /dev/null +++ b/util/ack/files.c @@ -0,0 +1,94 @@ +/* + * (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 ; + } +} diff --git a/util/ack/grows.c b/util/ack/grows.c new file mode 100644 index 00000000..0b870e00 --- /dev/null +++ b/util/ack/grows.c @@ -0,0 +1,79 @@ +/* + * (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 ; +} diff --git a/util/ack/grows.h b/util/ack/grows.h new file mode 100644 index 00000000..9e7d55c1 --- /dev/null +++ b/util/ack/grows.h @@ -0,0 +1,19 @@ +/* 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 */ diff --git a/util/ack/list.c b/util/ack/list.c new file mode 100644 index 00000000..fb28fd2a --- /dev/null +++ b/util/ack/list.c @@ -0,0 +1,73 @@ +/* + * (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 ; +} diff --git a/util/ack/list.h b/util/ack/list.h new file mode 100644 index 00000000..d39aea4c --- /dev/null +++ b/util/ack/list.h @@ -0,0 +1,23 @@ +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) ) diff --git a/util/ack/main.c b/util/ack/main.c new file mode 100644 index 00000000..bc0abf96 --- /dev/null +++ b/util/ack/main.c @@ -0,0 +1,340 @@ +/* + * (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 + +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 ) { + 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("Cannot produce the desired file from %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 ; + } +} diff --git a/util/ack/malloc.c b/util/ack/malloc.c new file mode 100644 index 00000000..b9ec3df2 --- /dev/null +++ b/util/ack/malloc.c @@ -0,0 +1,208 @@ +/* + * (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&&qptr = 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=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 diff --git a/util/ack/mktables.c b/util/ack/mktables.c new file mode 100644 index 00000000..fffaa038 --- /dev/null +++ b/util/ack/mktables.c @@ -0,0 +1,121 @@ +/* + * (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 +#include + +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 ; i2) ; + 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) ; +} diff --git a/util/ack/pc/.distr b/util/ack/pc/.distr new file mode 100644 index 00000000..df8c6bb9 --- /dev/null +++ b/util/ack/pc/.distr @@ -0,0 +1,2 @@ +Makefile +em_pc.c diff --git a/util/ack/pc/Makefile b/util/ack/pc/Makefile new file mode 100644 index 00000000..4d4f340f --- /dev/null +++ b/util/ack/pc/Makefile @@ -0,0 +1,25 @@ +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 diff --git a/util/ack/pc/em_pc.c b/util/ack/pc/em_pc.c new file mode 100644 index 00000000..8187abed --- /dev/null +++ b/util/ack/pc/em_pc.c @@ -0,0 +1,681 @@ +/* + * (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 + * + */ + +/* + * put all the pieces of the pascal part of the EM project together + * original author: Johan Stevenson, Vrije Universiteit, Amsterdam + * heavily modified by: Ed Keizer, Vrije Universiteit, Amsterdam + */ + +#include +#include +#include +#include +#include +#include +#include + +#define MAX_FLAG 40 /* The Max. no of '{' flags allowed */ + +#define void int + +char *pc_path = PEM_PATH ; +char *err_path = ERR_PATH; + +int toterr; +int parent; + +char *eeflag; +char *vvflag = "-V"; +int no_pemflag = 0 ; +char *pemflag[MAX_FLAG]; +char *eflag; +char *wflag; + +int sizes[sz_last+1] = { + 2, /* sz_addr */ + 8, /* sz_real */ + 0, /* sz_head */ + 512, /* sz_buff */ + 4096, /* sz_mset */ + 2, /* sz_iset */ +}; + +#define CALLSIZE 60 +char *callvector[CALLSIZE]; +char **av; +int ac; +int fileargs; /* number of recognized, processed args */ +int flagargs; +char *progname; +char *source; + +#define CHARSIZE 2500 +#define CHARMARG 50 +char charbuf[CHARSIZE]; +char *charp = charbuf; + +char *tmp_dir = TMP_DIR; +char *unique = "pcXXXXXX"; + +char sigs[] = { + SIGHUP, + SIGINT, + SIGTERM, + 0 +}; + +/* + * forward function declarations + */ +void finish(); +void pem(); +int list(); +char *flag(); +char *tempfile(); +char **initvector(); +char *basename(); + +/* + * used library routines and data + */ + +extern char *sys_errlist[]; +extern int errno; + +int atoi(); +void exit(); +void sleep(); +void execv(); +char *sbrk(); +int chdir(); +int fork(); +int wait(); +int getpid(); +int open(); +int close(); +int read(); + +main(argc,argv) char **argv; { + register char *p; + char *files[3] ; + + for (p = sigs; *p; p++) + if (signal(*p,finish) == SIG_IGN) + signal(*p,SIG_IGN); + ac = argc; + av = argv; + progname = *av++; + init(); + while ( --ac>0 ) { + p = *av++; + if (*p == '-') { + flagargs++; + p = flag(p); + } else { + if ( fileargs>=3 ) fatal("Too many file arguments") ; + files[fileargs++]= p; + } + } + if ( fileargs!=3 ) fatal("Not enough arguments") ; + source=files[2] ; + pem(files[0],files[1]) ; + finish(); +} + +char *flag(f) char *f; { + register char *p; + + p = f+1; + switch (*p++) { + case 'e': + eflag = f; + break; + case 'E': + eeflag = f; + break; + case 'w': + wflag = f; + break; + case 'V': + vvflag = f; + return(0); + case '{': + if ( no_pemflag>=MAX_FLAG ) { + ermess("too many flags, ignored %s",f) ; + } else { + pemflag[no_pemflag++] = p; + } + return(0); + case 'R': + pc_path= p ; + return 0 ; + case 'r' : + err_path= p ; + return 0 ; + default: + return(f); + } + if (*p) + fatal("bad flag %s",f); + return(0); +} + +initsizes(f) FILE *f; { + register c, i; + register char *p; + + p = vvflag + 2; + while (c = *p++) { + i = atoi(p); + while (*p >= '0' && *p <= '9') + p++; + switch (c) { + case 'p': sz_addr = i; continue; + case 'f': sz_real = i; continue; + case 'h': sz_head = i; continue; + case 'b': sz_buff = i; continue; + case 'm': sz_mset = i; continue; + case 'j': sz_iset = i; continue; + case 'w': + case 'i': if (i == 2) continue; break; + case 'l': if (i == 4) continue; break; + } + fatal("bad V-flag %s",vvflag); + } + if (sz_head == 0) + sz_head = 6*sz_word + 2*sz_addr; + for (i = 0; i <= sz_last; i++) + fprintf(f, "%d\n",sizes[i]); +} + +/* ------------------ calling sequences -------------------- */ + +pem(p,q) char *p,*q; { + register char **v,*d; + int i; + FILE *erfil; + + v = initvector(pc_path); + d = tempfile('d'); + if ((erfil = fopen(d,"w")) == NULL) + syserr(d); + initsizes(erfil); + fprintf(erfil,"%s\n",basename(source)); + for ( i=0 ; i 3) { +/* + if ((status & 0200) && tflag==0) + unlink("core"); +*/ + fatal("signal %d in %s. Ask an expert for help", + status&0177,callvector[0]); + } + if (status & 0177400) + toterr++; +} + +char **initvector(path) char *path; { + register char *p,**v; + + v = callvector; + p = path; + *v++ = p; + *v++ = basename(p); + return(v); +} + +finish() { + register char *p,*q; + register fd; + struct direct dir; + + signal(SIGINT,SIG_IGN); + if (parent != 0) { + chdir(tmp_dir); + fd = open(".",0); + while (read(fd,(char *) &dir,sizeof dir) == sizeof dir) { + if (dir.d_ino == 0) + continue; + p = unique; + q = dir.d_name; + while (*p++ == *q++) + if (*p == '\0') { + unlink(dir.d_name); + break; + } + } + close(fd); + } + exit(toterr ? -1 : 0); +} + + +donewith(p) char *p; { + + if (p >= charbuf && p < &charbuf[CHARSIZE]) + unlink(p); +} + +init() { + register char *p; + register i,fd; + + if ((fd = open(tmp_dir,0)) < 0) + tmp_dir = "."; + close(fd); + p = unique+2; + parent = i = getpid(); + do + *p++ = i % 10 + '0'; + while (i /= 10); + *p++ = '.'; *p = '\0'; +} + +/* ------------------- pascal listing ----------------------- */ + +#define MAXERNO 300 +#define MAXERRLIST 10 +#define IDMAX 8 + +struct errec { + int erno; + char mess[IDMAX+1]; + int mesi; + int chno; + int lino; +}; + +struct errec curr; +struct errec next; + +int *index = 0; +int maxerno; + +int errerr; +int errfat; + +int listlino; +int listorig; +int listrela; +char *listfnam; + +FILE *inpfil; +FILE *mesfil; +FILE *errfil; + +int errorline(); +int geterrec(); +int nexterror(); + +int list(p,q) char *p,*q; { + + if ((errfil = fopen(q,"r")) == NULL) + syserr(q); + if (geterrec() == 0) + if (eeflag==0) { + fclose(errfil); + return(0); + } + if (index == 0) { + index = (int *) sbrk(MAXERNO * sizeof index[0]); + fillindex(); + } + if ((inpfil = fopen(p,"r")) == NULL) + syserr(p); + errerr = 0; + errfat = 0; + listlino = 0; + listorig = 0; + listrela = 0; + listfnam = source; + if (eeflag) + listfull(); + else if (eflag) + listpartial(); + else + listshort(); + fclose(errfil); + fclose(inpfil); + fflush(stdout); + return(errfat ? -1 : 1); +} + +listshort() { + + while (nexterror()) { + while (listlino < curr.lino) + nextline(0); + printf("%s, line %d: ",listfnam,listrela); + string(&curr); + } +} + +listfull() { + + if (nexterror()) + do { + do { + nextline(1); + } while (listlino < curr.lino); + } while (errorline()); + while (nextline(1)) + ; +} + +listpartial() { + + if (nexterror()) + do { + do { + nextline(listlino >= curr.lino-2); + } while (listlino < curr.lino); + } while (errorline()); +} + +int nextline(printing) { + register ch; + + listlino++; + ch = getc(inpfil); + if (ch == '#') { + if (lineline(printing) == 0) + fatal("bad line directive"); + return(1); + } + listrela++; + if (listfnam == source) + listorig++; + if (ch != EOF) { + if (printing) + printf("%5d\t",listorig); + do { + if (printing) + putchar(ch); + if (ch == '\n') + return(1); + } while ((ch = getc(inpfil)) != EOF); + } + return(0); +} + +lineline(printing) { + register ch; + register char *p,*q; + static char line[100]; + + p = line; + while ((ch = getc(inpfil)) != '\n') { + if (ch == EOF || p == &line[100-1]) + return(0); + *p++ = ch; + } + *p = '\0'; p = line; + if (printing) + printf("\t#%s\n",p); + if ((listrela = atoi(p)-1) < 0) + return(0); + while ((ch = *p++) != '"') + if (ch == '\0') + return(0); + q = p; + while (ch = *p++) { + if (ch == '"') { + *--p = '\0'; + if ( source ) { + listfnam = strcmp(q,source)==0 ? source : q; + return(1); + } + source=q ; listfnam=q ; + return 1 ; + } + if (ch == '/') + q = p; + } + return(0); +} + +int errorline() { + register c; + register struct errec *p,*q; + struct errec lerr[MAXERRLIST]; + int goon; + + printf("*** ***"); + p = lerr; + c = 0; + do { + if (c < curr.chno) { + printf("%*c",curr.chno-c,'^'); + c = curr.chno; + } + if (p < &lerr[MAXERRLIST]) + *p++ = curr; + goon = nexterror(); + } while (goon && curr.lino==listlino); + putchar('\n'); + for (q = lerr; q < p; q++) + string(q); + putchar('\n'); + return(goon); +} + +int geterrec() { + register ch; + register char *p; + + ch = getc(errfil); + next.erno = 0; + next.mesi = -1; + next.mess[0] = '\0'; + if (ch == EOF) + return(0); + if (ch >= '0' && ch <= '9') { + ch = getnum(ch,&next.mesi); + } else if (ch == '\'') { + p = next.mess; + while ((ch = getc(errfil)) != ' ' && ch != EOF) + if (p < &next.mess[IDMAX]) + *p++ = ch; + *p = '\0'; + } + ch = getnum(ch, &next.erno); + ch = getnum(ch, &next.lino); + ch = getnum(ch, &next.chno); + if (ch != '\n') + fatal("bad error line"); + return(1); +} + +int getnum(ch, ip) register ch; register *ip; { + register neg; + + *ip = 0; + while (ch == ' ') + ch = getc(errfil); + if (neg = ch=='-') + ch = getc(errfil); + while (ch >= '0' && ch <= '9') { + *ip = *ip * 10 - '0' + ch; + ch = getc(errfil); + } + if (neg) + *ip = -(*ip); + return(ch); +} + +int nexterror() { + + do { /* skip warnings if wflag */ + curr = next; + if (curr.erno == 0) + return(0); + for (;;) { + if (geterrec() == 0) + break; + if (next.lino != curr.lino || next.chno != curr.chno) + break; + if (curr.erno < 0 && next.erno > 0) + /* promote warnings if they cause fatals */ + curr.erno = -curr.erno; + if (next.mess[0] != '\0' || next.mesi != -1) + /* give all parameterized errors */ + break; + if (curr.mess[0] != '\0' || curr.mesi != -1) + /* and at least a non-parameterized one */ + break; + } + } while (curr.erno < 0 && wflag != 0); + return(1); +} + +fillindex() { + register *ip,n,c; + + if ((mesfil = fopen(err_path,"r")) == NULL) + syserr(err_path); + ip = index; + *ip++ = 0; + n = 0; + while ((c = getc(mesfil)) != EOF) { + n++; + if (c == '\n') { + *ip++ = n; + if (ip > &index[MAXERNO]) + fatal("too many errors on %s",err_path); + } + } + maxerno = ip - index; +} + +string(ep) register struct errec *ep; { + register i,n; + + errerr++; + if ((i = ep->erno) < 0) { + i = -i; + printf("Warning: "); + } else + errfat++; + if (i == 0 || i >= maxerno) + fatal("bad error number %d",i); + n = index[i] - index[i-1]; + fseek(mesfil,(long)index[i-1],0); + while (--n >= 0) { + i = getc(mesfil); + if (i == '%' && --n>=0) { + i = getc(mesfil); + if (i == 'i') + printf("%d", ep->mesi); + else if (i == 's') + printf("%s", ep->mess); + else + putchar(i); + } else + putchar(i); + } +} + +/* ------------------- error routines -------------------------- */ + +/* VARARGS1 */ +void ermess(s,a1,a2,a3,a4) char *s; { + + fprintf(stderr,"%s: ",progname); + fprintf(stderr,s,a1,a2,a3,a4); + fprintf(stderr,"\n"); +} + +syserr(s) char *s; { + fatal("%s: %s",s,sys_errlist[errno]); +} + +/* VARARGS1 */ +void fatal(s,a1,a2,a3,a4) char *s; { + + ermess(s,a1,a2,a3,a4); + toterr++; + finish(); +} diff --git a/util/ack/run.c b/util/ack/run.c new file mode 100644 index 00000000..a55c759f --- /dev/null +++ b/util/ack/run.c @@ -0,0 +1,154 @@ +/* + * (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 + +#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 ; +} diff --git a/util/ack/scan.c b/util/ack/scan.c new file mode 100644 index 00000000..63a5b7c1 --- /dev/null +++ b/util/ack/scan.c @@ -0,0 +1,244 @@ +/* + * (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_ocountocount ) ) ) { + /* 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") ; +} diff --git a/util/ack/svars.c b/util/ack/svars.c new file mode 100644 index 00000000..4749fe1e --- /dev/null +++ b/util/ack/svars.c @@ -0,0 +1,125 @@ +/* + * (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 ; +} diff --git a/util/ack/trans.c b/util/ack/trans.c new file mode 100644 index 00000000..3eeab984 --- /dev/null +++ b/util/ack/trans.c @@ -0,0 +1,672 @@ +/* + * (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 && eqt_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 && nct_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) ; +} diff --git a/util/ack/trans.h b/util/ack/trans.h new file mode 100644 index 00000000..7e305d60 --- /dev/null +++ b/util/ack/trans.h @@ -0,0 +1,30 @@ +/* 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)) diff --git a/util/ack/util.c b/util/ack/util.c new file mode 100644 index 00000000..ac32f38c --- /dev/null +++ b/util/ack/util.c @@ -0,0 +1,190 @@ +/* + * (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 +#include + +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 ; +} diff --git a/util/cgg/Makefile b/util/cgg/Makefile new file mode 100644 index 00000000..4b47a6da --- /dev/null +++ b/util/cgg/Makefile @@ -0,0 +1,30 @@ +# $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 + +bootgram.c: bootgram.y + @echo expect 1 shift/reduce conflict + yacc bootgram.y + mv y.tab.c bootgram.c + +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 diff --git a/util/cgg/bootgram.y b/util/cgg/bootgram.y new file mode 100644 index 00000000..05de7446 --- /dev/null +++ b/util/cgg/bootgram.y @@ -0,0 +1,2317 @@ +%{ + +#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 +#include +#include +#include +#include +#include +#include + +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 list1,structlistel +%type structlist,structdecl +%type expr optexpr +%type optcost cost optcommacost +%type optboolexpr optnocoerc mnem emargno tokargno optprop +%type optcommabool optstack subreg tokenexpressionno optregvar +%type tokeninstanceno code stackreplacement optslashnumber +%type tokenexpression +%type tokeninstance +%type optformat +%token IDENT TYPENAME +%token RIDENT,PIDENT,TIDENT,EIDENT +%token LSTRING,STRING +%token NUMBER +%token 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 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;irmembers[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;irprop[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;ii_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;i1) + 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;ic2_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;ii_i.i_regno; + for (i=1;i= 'a'+nallreg) + yyerror("Bad letter in %[x] construct"); + $$.in_which = IN_ALLOC; + $$.in_info[0] = $3-'a'; + $$.in_info[1] = $4; + for (i=2;ii_i.i_tokno; + for(i=0;ii_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;ii_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;itokpatlen) + 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;pex_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>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;irmembers[i]) + regbits[member>>4] |= (1<<(member&017)); + } + for (i=0;irmembers[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 \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;irname = "cc reg"; + r->rrepr = "CC"; + r->rsize = -1; + r->rregvar= -1; + for(i=0;irmembers[i] = 0; + for(i=0;irprop[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>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;irrepr), + machregs[i]->rsize); + if (maxmembers!=0) { + fprintf(cfile,",{"); + for(j=0;jrmembers[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>4]&(1<<(j&017))) + for (k=0;krmembers[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;jrmembers[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;iex_operator,np->ex_lnode, + np->ex_rnode); + fprintf(cfile,"};\n\nstring codestrings[] = {\n"); + for(i=0;im_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;irregvar<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;i0) + 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;j0) + 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;ii_type=IEXP; + ip->i_i.i_expno = nmachsets++; + + for (i=0;ii_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;irprop[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;it_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;it_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>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>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;offsett_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; + 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;ii_next) + printf("%-14s %1d %3d\n",ip->i_name, + ip->i_type,ip->i_i.i_regno); + } + + for(i=2;irname,rp->rrepr,rp->rsize); + for(j=0;jrmembers[j] != 0) + printf(", %s",machregs[rp->rmembers[j]]->rname); + printf(")"); + for(j=0;jrprop[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" diff --git a/util/cgg/bootlex.l b/util/cgg/bootlex.l new file mode 100644 index 00000000..67f87139 --- /dev/null +++ b/util/cgg/bootlex.l @@ -0,0 +1,189 @@ +%{ + +#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++; +} diff --git a/util/opt/Makefile b/util/opt/Makefile new file mode 100644 index 00000000..e2c5e1dc --- /dev/null +++ b/util/opt/Makefile @@ -0,0 +1,202 @@ +# $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 diff --git a/util/opt/alloc.c b/util/opt/alloc.c new file mode 100644 index 00000000..bcb86d0b --- /dev/null +++ b/util/opt/alloc.c @@ -0,0 +1,448 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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;sizeco_next; + tp->co_size = size; + if (corelist==0 || tpco_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 diff --git a/util/opt/alloc.h b/util/opt/alloc.h new file mode 100644 index 00000000..23c2e389 --- /dev/null +++ b/util/opt/alloc.h @@ -0,0 +1,55 @@ +/* $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 */ diff --git a/util/opt/assert.h b/util/opt/assert.h new file mode 100644 index 00000000..c117405c --- /dev/null +++ b/util/opt/assert.h @@ -0,0 +1,7 @@ +/* $Header$ */ + +#ifndef NDEBUG +#define assert(x) if(!(x)) badassertion(__FILE__,__LINE__) +#else +#define assert(x) /* nothing */ +#endif diff --git a/util/opt/backward.c b/util/opt/backward.c new file mode 100644 index 00000000..ab842f84 --- /dev/null +++ b/util/opt/backward.c @@ -0,0 +1,187 @@ +#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;ns_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; +} diff --git a/util/opt/cleanup.c b/util/opt/cleanup.c new file mode 100644 index 00000000..d4525d4a --- /dev/null +++ b/util/opt/cleanup.c @@ -0,0 +1,65 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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); +} diff --git a/util/opt/ext.h b/util/opt/ext.h new file mode 100644 index 00000000..79767b29 --- /dev/null +++ b/util/opt/ext.h @@ -0,0 +1,16 @@ +/* $Header$ */ + +#ifndef FILE +#include +#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; diff --git a/util/opt/flow.c b/util/opt/flow.c new file mode 100644 index 00000000..2f7d79ad --- /dev/null +++ b/util/opt/flow.c @@ -0,0 +1,126 @@ +#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; + } + } +} diff --git a/util/opt/getline.c b/util/opt/getline.c new file mode 100644 index 00000000..d1080f9c --- /dev/null +++ b/util/opt/getline.c @@ -0,0 +1,556 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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;il_instr = n; + lnp->l_next = curpro.lastline; + curpro.lastline = lnp; + return(0); +} + +tstinpro() { + + if (prodepth==0) + error("This is not allowed outside a procedure"); +} diff --git a/util/opt/line.h b/util/opt/line.h new file mode 100644 index 00000000..d24237da --- /dev/null +++ b/util/opt/line.h @@ -0,0 +1,88 @@ +/* $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) diff --git a/util/opt/lookup.c b/util/opt/lookup.c new file mode 100644 index 00000000..d6126e34 --- /dev/null +++ b/util/opt/lookup.c @@ -0,0 +1,94 @@ +#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); +} diff --git a/util/opt/lookup.h b/util/opt/lookup.h new file mode 100644 index 00000000..0d36e3b4 --- /dev/null +++ b/util/opt/lookup.h @@ -0,0 +1,25 @@ +/* $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 diff --git a/util/opt/main.c b/util/opt/main.c new file mode 100644 index 00000000..11b274fd --- /dev/null +++ b/util/opt/main.c @@ -0,0 +1,77 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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); + } +} diff --git a/util/opt/makedepend b/util/opt/makedepend new file mode 100755 index 00000000..31e2e20d --- /dev/null +++ b/util/opt/makedepend @@ -0,0 +1,15 @@ +: '$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 diff --git a/util/opt/mktab.y b/util/opt/mktab.y new file mode 100644 index 00000000..f5bffa8a --- /dev/null +++ b/util/opt/mktab.y @@ -0,0 +1,366 @@ +%{ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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 MNEM +%token NUMBER +%type 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;imaxpatlen) 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;pex_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;pex_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>8)&0377); +} + +out(w) { + + if (w<255) { + outbyte(w); + } else { + outbyte(255); + outshort(w); + } +} + +#include "scan.c" diff --git a/util/opt/optim.h b/util/opt/optim.h new file mode 100644 index 00000000..d59e4375 --- /dev/null +++ b/util/opt/optim.h @@ -0,0 +1,12 @@ +/* $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 diff --git a/util/opt/param.h b/util/opt/param.h new file mode 100644 index 00000000..167d1265 --- /dev/null +++ b/util/opt/param.h @@ -0,0 +1,15 @@ +/* $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 diff --git a/util/opt/pattern.h b/util/opt/pattern.h new file mode 100644 index 00000000..e2211934 --- /dev/null +++ b/util/opt/pattern.h @@ -0,0 +1,126 @@ +/* $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[]; diff --git a/util/opt/patterns b/util/opt/patterns new file mode 100644 index 00000000..163eb792 --- /dev/null +++ b/util/opt/patterns @@ -0,0 +1,475 @@ +/* $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=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 diff --git a/util/opt/peephole.c b/util/opt/peephole.c new file mode 100644 index 00000000..1a52beea --- /dev/null +++ b/util/opt/peephole.c @@ -0,0 +1,652 @@ +#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 +#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<>(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<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;il_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; il_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 */ +} diff --git a/util/opt/process.c b/util/opt/process.c new file mode 100644 index 00000000..0c763d84 --- /dev/null +++ b/util/opt/process.c @@ -0,0 +1,185 @@ +#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; + } + } +} diff --git a/util/opt/proinf.h b/util/opt/proinf.h new file mode 100644 index 00000000..0813fef1 --- /dev/null +++ b/util/opt/proinf.h @@ -0,0 +1,36 @@ +/* $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; diff --git a/util/opt/putline.c b/util/opt/putline.c new file mode 100644 index 00000000..cc152bca --- /dev/null +++ b/util/opt/putline.c @@ -0,0 +1,379 @@ +#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;lengthab_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++ ); + } +} diff --git a/util/opt/reg.c b/util/opt/reg.c new file mode 100644 index 00000000..643fb953 --- /dev/null +++ b/util/opt/reg.c @@ -0,0 +1,101 @@ +#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; + } +} diff --git a/util/opt/scan.l b/util/opt/scan.l new file mode 100644 index 00000000..834f9cf6 --- /dev/null +++ b/util/opt/scan.l @@ -0,0 +1,76 @@ +%{ +#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++; } diff --git a/util/opt/special.c b/util/opt/special.c new file mode 100644 index 00000000..5147aa90 --- /dev/null +++ b/util/opt/special.c @@ -0,0 +1,33 @@ +#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); +} diff --git a/util/opt/testopt b/util/opt/testopt new file mode 100755 index 00000000..02f32f08 --- /dev/null +++ b/util/opt/testopt @@ -0,0 +1,8 @@ +: '$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 diff --git a/util/opt/types.h b/util/opt/types.h new file mode 100644 index 00000000..9b946219 --- /dev/null +++ b/util/opt/types.h @@ -0,0 +1,21 @@ +/* $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 diff --git a/util/opt/util.c b/util/opt/util.c new file mode 100644 index 00000000..85529cdc --- /dev/null +++ b/util/opt/util.c @@ -0,0 +1,62 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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 diff --git a/util/opt/var.c b/util/opt/var.c new file mode 100644 index 00000000..9d5be0a5 --- /dev/null +++ b/util/opt/var.c @@ -0,0 +1,40 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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 */