diff --git a/lang/pc/pem/Makefile b/lang/pc/pem/Makefile deleted file mode 100644 index 1293ea316..000000000 --- a/lang/pc/pem/Makefile +++ /dev/null @@ -1,44 +0,0 @@ -# $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 deleted file mode 100644 index b2c32ce1c..000000000 --- a/lang/pc/pem/move.c +++ /dev/null @@ -1,20 +0,0 @@ -/* 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 deleted file mode 100644 index ccd399a4f..000000000 --- a/lang/pc/pem/pem.p +++ /dev/null @@ -1,3138 +0,0 @@ -#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 deleted file mode 100644 index 41738ccd4..000000000 --- a/lib/6500/descr +++ /dev/null @@ -1,27 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=m6500 -var M=6500 -var LIB=mach/6500/lib/tail_ -var RT=mach/6500/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_be - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) -o > (.e:{TAIL}={EM}/{LIB}em) - prop C -end diff --git a/lib/6809/descr b/lib/6809/descr deleted file mode 100644 index c08ac85a6..000000000 --- a/lib/6809/descr +++ /dev/null @@ -1,31 +0,0 @@ -var w=2 -var i=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=m6809 -var M=6809 -var LIB=mach/6809/lib/tail_ -var RT=mach/6809/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_be - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) \ -({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em) - prop C -end diff --git a/lib/descr/cpm b/lib/descr/cpm deleted file mode 100644 index 262b12446..000000000 --- a/lib/descr/cpm +++ /dev/null @@ -1,25 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=4 -var M=cpm -var NAME=CPM -var LIB=mach/z80/int/lib/tail_ -var RT=mach/z80/int/lib/head_ -var SIZE_F=-sm -var INCLUDES=-I{EM}/include -name asld - from .k.m.a - to e.out - program {EM}/lib/em_ass - mapflag -l* LNAME={EM}/{LIB}* - mapflag -+* ASS_F={ASS_F?} -+* - mapflag --* ASS_F={ASS_F?} --* - mapflag -s* SIZE_F=-s* - args {ASS_F?} ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.c.p:{TAIL}={EM}/{LIB}mon) - prop C -end diff --git a/lib/descr/fe.src b/lib/descr/fe.src deleted file mode 100644 index 288d5219a..000000000 --- a/lib/descr/fe.src +++ /dev/null @@ -1,60 +0,0 @@ -# (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. -name cpp - # no from, it's governed by the P property - to .i - program {EM}/lib/cpp - mapflag -I* CPP_F={CPP_F?} -I* - mapflag -U* CPP_F={CPP_F?} -U* - mapflag -D* CPP_F={CPP_F?} -D* - args {CPP_F?} {INCLUDES?} -D{NAME} -DEM_WSIZE={w} -DEM_PSIZE={p} \ --DEM_SSIZE={s} -DEM_LSIZE={l} -DEM_FSIZE={f} -DEM_DSIZE={d} < - prop >P -end -name cem - from .c - to .k - program {EM}/lib/em_cem - mapflag -p CEM_F={CEM_F?} -Xp - mapflag -L CEM_F={CEM_F?} -l - args -Vw{w}i{w}p{p}f{f}s{s}l{l}d{d} {CEM_F?} - prop <>p - rts .c - need .c -end -name pc - from .p - to .k - program {EM}/lib/em_pc - mapflag -p PC_F={PC_F?} -p - mapflag -w PC_F={PC_F?} -w - mapflag -E PC_F={PC_F?} -E - mapflag -e PC_F={PC_F?} -e - mapflag -{*} PC_F={PC_F?} -\{*} - mapflag -L PC_F={PC_F?} -\{l-} - args -Vw{w}p{p}f{d}l{l} {PC_F?} < > {SOURCE} - prop m - rts .p - need .p - end - name encode - from .e - to .k - program {EM}/lib/em_encode - args < - prop >m -end -name opt - from .k - to .m - program {EM}/lib/em_opt - mapflag -LIB OPT_F={OPT_F?} -L - args {OPT_F?} < - prop >O -end -name decode - from .k.m - to .e - program {EM}/lib/em_decode - args < - prop > -end diff --git a/lib/descr/nascom b/lib/descr/nascom deleted file mode 100644 index c9a560a6c..000000000 --- a/lib/descr/nascom +++ /dev/null @@ -1,28 +0,0 @@ -var w=1 -var p=2 -var s=1 -var l=2 -var f=4 -var d=8 -var NAME=nascom -var M=z80a -var LIB=mach/z80a/lib/tail_ -var RT=mach/z80a/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_be - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) ({RTS}:.c={EM}/{RT}cc) -o > \ -(.e:{TAIL}={EM}/{LIB}em.1 {EM}/{LIB}em.2) - prop C -end diff --git a/lib/em22/descr b/lib/em22/descr deleted file mode 100644 index 6d897fb15..000000000 --- a/lib/em22/descr +++ /dev/null @@ -1,27 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var M=int -var NAME=int22 -var LIB=mach/int/lib/tail_ -var RT=mach/int/lib/head_ -var SIZE_FLAG=-sm -var INCLUDES=-I{EM}/include -name asld - from .k.m.a - to e.out - program {EM}/lib/em_ass - mapflag -l* LNAME={EM}/{LIB}* - mapflag -+* ASS_F={ASS_F?} -+* - mapflag --* ASS_F={ASS_F?} --* - mapflag -s* SIZE_FLAG=-s* - args {SIZE_FLAG} \ - ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ - (.p:{TAIL}={EM}/{LIB}pc) \ - (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ - (.c.p:{TAIL}={EM}/{LIB}mon) - prop C -end diff --git a/lib/i80/descr b/lib/i80/descr deleted file mode 100644 index 2b31a593e..000000000 --- a/lib/i80/descr +++ /dev/null @@ -1,27 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=i8080 -var M=8080 -var LIB=mach/8080/lib/tail_ -var RT=mach/8080/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_be - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args ({RTS}:.c={EM}/{RT}cc) -o > < - prop C -end diff --git a/lib/i86/descr b/lib/i86/descr deleted file mode 100644 index 7135e9f71..000000000 --- a/lib/i86/descr +++ /dev/null @@ -1,32 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=i8086 -var M=i86 -var LIB=mach/i86/lib/tail_ -var RT=mach/i86/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_cg - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - mapflag -i IFILE={EM}/{RT}i - args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \ -({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.c.p.e:{TAIL}={EM}/{LIB}alo) (.c.p:{TAIL}={EM}/{LIB}mon) \ -(.e:{TAIL}={EM}/{LIB}em) - prop C -end diff --git a/lib/m68k2/descr b/lib/m68k2/descr deleted file mode 100644 index 7cd66069e..000000000 --- a/lib/m68k2/descr +++ /dev/null @@ -1,30 +0,0 @@ -var w=2 -var p=4 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=m68k2 -var M=m68k2 -var LIB=mach/m68k2/lib/tail_ -var RT=mach/m68k2/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_cg - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) \ -({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon {EM}/{LIB}em.vend) - prop Cm -end diff --git a/lib/m68k4/descr b/lib/m68k4/descr deleted file mode 100644 index 16f1f4904..000000000 --- a/lib/m68k4/descr +++ /dev/null @@ -1,34 +0,0 @@ -var w=4 -var p=4 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=m68k4 -var M=m68k4 -var LIBDIR=mach/m68k4/lib -var LIB=mach/m68k4/lib/tail_ -var RT=mach/m68k4/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_cg - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) \ -({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p.c:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \ -(.c:{TAIL}={EM}/{LIBDIR}/write.s) \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \ -(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend) - prop Cm -end diff --git a/lib/pdp/descr b/lib/pdp/descr deleted file mode 100644 index 3a90a8b9d..000000000 --- a/lib/pdp/descr +++ /dev/null @@ -1,38 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var M=pdp -var NAME=pdp -var LIB=mach/pdp/lib/tail_ -var RT=mach/pdp/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_cg - args < - prop > - need .e -end -name as - from .s - to .o - program /bin/as - args - -o > < - prop m -end -name ld - from .o.a - to a.out - program /bin/ld - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) \ - ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ - (.p:{TAIL}={EM}/{LIB}pc) \ - (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ - (.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}=/lib/libc.a) - prop C -end diff --git a/lib/vax4/descr.src b/lib/vax4/descr.src deleted file mode 100644 index f9c1e5e3a..000000000 --- a/lib/vax4/descr.src +++ /dev/null @@ -1,37 +0,0 @@ -var w=4 -var p=4 -var s=2 -var l=4 -var f=4 -var d=8 -var M=vax4 -var NAME=vax4 -var LIB=mach/vax4/lib/tail_ -var RT=mach/vax4/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_cg - args < - prop > - need .e -end -name as - from .s - to .o - program /bin/as - args - -o > < - prop m -end -name ld - from .o.a - to a.out - program /bin/ld - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) \ -({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}={EM}/{LIB}mon) - prop C -end diff --git a/lib/z80/descr b/lib/z80/descr deleted file mode 100644 index f201f983b..000000000 --- a/lib/z80/descr +++ /dev/null @@ -1,31 +0,0 @@ -var w=2 -var p=2 -var s=2 -var l=4 -var f=4 -var d=8 -var NAME=z80 -var M=z80 -var LIB=mach/z80/lib/tail_ -var RT=mach/z80/lib/head_ -var INCLUDES=-I{EM}/include -name be - from .m - to .s - program {EM}/lib/{M}_cg - args < - prop > - need .e -end -name asld - from .s.a - to a.out - program {EM}/lib/{M}_as - mapflag -l* LNAME={EM}/{LIB}* - args (.e:{HEAD}={EM}/{RT}em) \ -({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ -(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ -(.c.p.e:{TAIL}={EM}/{LIB}alo) (.c.p:{TAIL}={EM}/{LIB}mon) \ -(.e:{TAIL}={EM}/{LIB}em.vend) - prop C -end diff --git a/mach/6500/cg/Makefile b/mach/6500/cg/Makefile deleted file mode 100644 index 522d02add..000000000 --- a/mach/6500/cg/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# $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 deleted file mode 100644 index 522d02add..000000000 --- a/mach/pdp/cg/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# $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 deleted file mode 100644 index cd33ca5d1..000000000 --- a/mach/pdp/cg/mach.c +++ /dev/null @@ -1,171 +0,0 @@ -#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 deleted file mode 100644 index 522d02add..000000000 --- a/mach/proto/cg/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# $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 deleted file mode 100644 index 3cc93b88b..000000000 --- a/mach/proto/cg/assert.h +++ /dev/null @@ -1,7 +0,0 @@ -/* $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 deleted file mode 100644 index 8c4fb6f0d..000000000 --- a/mach/proto/cg/codegen.c +++ /dev/null @@ -1,672 +0,0 @@ -#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 deleted file mode 100644 index ecfe7f677..000000000 --- a/mach/proto/cg/data.h +++ /dev/null @@ -1,54 +0,0 @@ -/* $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 deleted file mode 100644 index 0e677d376..000000000 --- a/mach/proto/cg/equiv.c +++ /dev/null @@ -1,105 +0,0 @@ -#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 deleted file mode 100644 index f1dc6c852..000000000 --- a/mach/proto/cg/equiv.h +++ /dev/null @@ -1,8 +0,0 @@ -/* $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 deleted file mode 100644 index 5e84bf52a..000000000 --- a/mach/proto/cg/extern.h +++ /dev/null @@ -1,49 +0,0 @@ -/* $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 deleted file mode 100644 index b3856fa94..000000000 --- a/mach/proto/cg/fillem.c +++ /dev/null @@ -1,644 +0,0 @@ -#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 deleted file mode 100644 index ea1ccbe5c..000000000 --- a/mach/proto/cg/gencode.c +++ /dev/null @@ -1,194 +0,0 @@ -#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 deleted file mode 100644 index cf8f0297f..000000000 --- a/mach/proto/cg/glosym.c +++ /dev/null @@ -1,52 +0,0 @@ -#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 deleted file mode 100644 index 7fb4c7cf1..000000000 --- a/mach/proto/cg/glosym.h +++ /dev/null @@ -1,9 +0,0 @@ -/* $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 deleted file mode 100644 index 08d5c46c2..000000000 --- a/mach/proto/cg/main.c +++ /dev/null @@ -1,84 +0,0 @@ -#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 deleted file mode 100644 index b74e55083..000000000 --- a/mach/proto/cg/move.c +++ /dev/null @@ -1,110 +0,0 @@ -#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 deleted file mode 100644 index 4aab43f2e..000000000 --- a/mach/proto/cg/nextem.c +++ /dev/null @@ -1,131 +0,0 @@ -#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 deleted file mode 100644 index 24326015b..000000000 --- a/mach/proto/cg/param.h +++ /dev/null @@ -1,19 +0,0 @@ -/* $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 deleted file mode 100644 index 4482dce10..000000000 --- a/mach/proto/cg/reg.c +++ /dev/null @@ -1,175 +0,0 @@ -#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 deleted file mode 100644 index 6379b9bc2..000000000 --- a/mach/proto/cg/regvar.c +++ /dev/null @@ -1,151 +0,0 @@ -#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 deleted file mode 100644 index 716a68f2b..000000000 --- a/mach/proto/cg/regvar.h +++ /dev/null @@ -1,19 +0,0 @@ -/* $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 deleted file mode 100644 index e4fa6299a..000000000 --- a/mach/proto/cg/result.h +++ /dev/null @@ -1,19 +0,0 @@ -/* $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 deleted file mode 100644 index 0543c96a4..000000000 --- a/mach/proto/cg/salloc.c +++ /dev/null @@ -1,150 +0,0 @@ -#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 deleted file mode 100644 index 820416905..000000000 --- a/mach/proto/cg/state.h +++ /dev/null @@ -1,24 +0,0 @@ -/* $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 deleted file mode 100644 index 90f0add97..000000000 --- a/mach/proto/cg/subr.c +++ /dev/null @@ -1,547 +0,0 @@ -#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 deleted file mode 100644 index 2c15ac0de..000000000 --- a/mach/proto/cg/types.h +++ /dev/null @@ -1,33 +0,0 @@ -/* $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 deleted file mode 100644 index 48de9ba1d..000000000 --- a/mach/proto/cg/var.c +++ /dev/null @@ -1,41 +0,0 @@ -#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 deleted file mode 100644 index 522d02add..000000000 --- a/mach/vax4/cg/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# $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 deleted file mode 100644 index 522d02add..000000000 --- a/mach/z80/cg/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# $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 deleted file mode 100644 index 522d02add..000000000 --- a/mach/z8000/cg/Makefile +++ /dev/null @@ -1,178 +0,0 @@ -# $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/Makefile b/util/ack/Makefile deleted file mode 100644 index 3b985e7d2..000000000 --- a/util/ack/Makefile +++ /dev/null @@ -1,63 +0,0 @@ -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 deleted file mode 100644 index b084a647b..000000000 --- a/util/ack/ack.h +++ /dev/null @@ -1,88 +0,0 @@ -/****************************************************************************/ -/* 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 deleted file mode 100644 index b92fc8bd8..000000000 --- a/util/ack/data.c +++ /dev/null @@ -1,9 +0,0 @@ -#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 deleted file mode 100644 index 23af80c5c..000000000 --- a/util/ack/data.h +++ /dev/null @@ -1,43 +0,0 @@ -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 deleted file mode 100644 index 1e7880ada..000000000 --- a/util/ack/dmach.h +++ /dev/null @@ -1,15 +0,0 @@ -/***************************************************************/ -/* */ -/* 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 deleted file mode 100644 index 83f14cd90..000000000 --- a/util/ack/files.c +++ /dev/null @@ -1,94 +0,0 @@ -/* - * (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 deleted file mode 100644 index 0b870e003..000000000 --- a/util/ack/grows.c +++ /dev/null @@ -1,79 +0,0 @@ -/* - * (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 deleted file mode 100644 index 9e7d55c12..000000000 --- a/util/ack/grows.h +++ /dev/null @@ -1,19 +0,0 @@ -/* 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 deleted file mode 100644 index fb28fd2ad..000000000 --- a/util/ack/list.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * (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 deleted file mode 100644 index d39aea4c1..000000000 --- a/util/ack/list.h +++ /dev/null @@ -1,23 +0,0 @@ -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 deleted file mode 100644 index 46292ceb3..000000000 --- a/util/ack/main.c +++ /dev/null @@ -1,340 +0,0 @@ -/* - * (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("Incomplete internal specification for %s",arg) ; - l_add(&c_arguments,keeps(arg)) ; - return 1 ; - case F_NOMATCH : - if ( stopsuffix ) werror("Unknown suffix in %s",arg) ; - l_add(&c_arguments,keeps(arg)) ; - return 1 ; - case F_OK : - break ; - } - orig.p_keeps= NO; - in= orig ; - scanlist(l_first(tr_list), elem) { - phase= t_cont(*elem) ; - if ( phase->t_do ) { /* perform this transformation */ - if ( first ) { - if ( !nill_flag ) { - printf("%s\n",arg) ; - } - switch ( phase->t_prep ) { - default : if ( !mayprep() ) break ; - case YES: if ( !transform(cpp_trafo) ) { - n_error++ ; -#ifdef DEBUG - vprint("Pre-processor failed\n") ; -#endif - return 0 ; - } - case NO : - break ; - } - } - if ( cpp_trafo && stopsuffix && - strcmp(cpp_trafo->t_out,stopsuffix)==0 ) { - break ; - } - if ( !transform(phase) ) { - n_error++ ; -#ifdef DEBUG - if ( debug ) { - vprint("phase %s for %s failed\n", - phase->t_name,orig.p_path) ; - } -#endif - return 0 ; - } - first=NO ; - } - } -#ifdef DEBUG - if ( debug ) vprint("Transformation complete for %s\n",orig.p_path) ; -#endif - if ( !in.p_keep ) fatal("attempt to discard the result file") ; - l_add(&c_arguments,keeps(in.p_path)); - disc_files() ; - return 1 ; -} - -mayprep() { - int file ; - char fc ; - file=open(in.p_path,0); - if ( file<0 ) return 0 ; - if ( read(file,&fc,1)!=1 ) fc=0 ; - close(file) ; - return fc=='#' ; -} - -keephead(suffix) char *suffix ; { - l_add(&head_list, suffix) ; -} - -keeptail(suffix) char *suffix ; { - l_add(&tail_list, suffix) ; -} - -scanneeds() { - register list_elem *elem ; - scanlist(l_first(head_list), elem) { setneeds(l_content(*elem),0) ; } - l_clear(&head_list) ; - scanlist(l_first(tail_list), elem) { setneeds(l_content(*elem),1) ; } - l_clear(&tail_list) ; -} - -setneeds(suffix,tail) char *suffix ; { - register list_elem *elem ; - register trf *phase ; - - p_suffix= suffix ; - switch ( setpath() ) { - case F_OK : - scanlist( l_first(tr_list), elem ) { - phase = t_cont(*elem) ; - if ( phase->t_do ) { - if ( phase->t_needed ) { - if ( tail ) - add_tail(phase->t_needed) ; - else - add_head(phase->t_needed) ; - } - } - } - break ; - case F_NOMATCH : - werror("\"%s\": unrecognized suffix",suffix) ; - break ; - case F_NOPATH : - werror("incomplete internal specification for %s files", - suffix) ; - break ; - } -} diff --git a/util/ack/malloc.c b/util/ack/malloc.c deleted file mode 100644 index b9ec3df2c..000000000 --- a/util/ack/malloc.c +++ /dev/null @@ -1,208 +0,0 @@ -/* - * (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 deleted file mode 100644 index fffaa038d..000000000 --- a/util/ack/mktables.c +++ /dev/null @@ -1,121 +0,0 @@ -/* - * (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/Makefile b/util/ack/pc/Makefile deleted file mode 100644 index 9089e908a..000000000 --- a/util/ack/pc/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -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 - -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 deleted file mode 100644 index 16a138298..000000000 --- a/util/ack/pc/em_pc.c +++ /dev/null @@ -1,681 +0,0 @@ -/* - * (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, %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 deleted file mode 100644 index a55c759f9..000000000 --- a/util/ack/run.c +++ /dev/null @@ -1,154 +0,0 @@ -/* - * (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 deleted file mode 100644 index 63a5b7c1a..000000000 --- a/util/ack/scan.c +++ /dev/null @@ -1,244 +0,0 @@ -/* - * (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 deleted file mode 100644 index 4749fe1ef..000000000 --- a/util/ack/svars.c +++ /dev/null @@ -1,125 +0,0 @@ -/* - * (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 deleted file mode 100644 index 3eeab9841..000000000 --- a/util/ack/trans.c +++ /dev/null @@ -1,672 +0,0 @@ -/* - * (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 deleted file mode 100644 index 7e305d605..000000000 --- a/util/ack/trans.h +++ /dev/null @@ -1,30 +0,0 @@ -/* 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 deleted file mode 100644 index ac32f38ca..000000000 --- a/util/ack/util.c +++ /dev/null @@ -1,190 +0,0 @@ -/* - * (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 deleted file mode 100644 index 43d8a1b29..000000000 --- a/util/cgg/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -# $Header$ - -PREFLAGS=-I../../h -CFLAGS=$(PREFLAGS) -LDFLAGS=-i -LINTOPTS=-hbxac $(PREFLAGS) -LIBS=../../lib/em_data.a -# LEXLIB is system dependent, try -ll or -lln first -LEXLIB=-lln - -cgg: bootgram.o - cc $(LDFLAGS) bootgram.o $(LIBS) $(LEXLIB) -o cgg - -install: cgg - cp cgg ../../lib/cgg - -cmp: cgg - cmp cgg ../../lib/cgg - -lint: bootgram.c - lint $(LINTOPTS) bootgram.c -clean: - rm -f bootgram.o bootgram.c bootlex.c cgg -bootgram.o: bootlex.c -bootgram.o: ../../h/cg_pattern.h diff --git a/util/cgg/bootgram.y b/util/cgg/bootgram.y deleted file mode 100644 index 05de7446b..000000000 --- a/util/cgg/bootgram.y +++ /dev/null @@ -1,2317 +0,0 @@ -%{ - -#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 deleted file mode 100644 index 67f87139a..000000000 --- a/util/cgg/bootlex.l +++ /dev/null @@ -1,189 +0,0 @@ -%{ - -#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 deleted file mode 100644 index e2c5e1dc2..000000000 --- a/util/opt/Makefile +++ /dev/null @@ -1,202 +0,0 @@ -# $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 deleted file mode 100644 index bcb86d0bb..000000000 --- a/util/opt/alloc.c +++ /dev/null @@ -1,448 +0,0 @@ -#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 deleted file mode 100644 index 23c2e3890..000000000 --- a/util/opt/alloc.h +++ /dev/null @@ -1,55 +0,0 @@ -/* $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 deleted file mode 100644 index c117405c1..000000000 --- a/util/opt/assert.h +++ /dev/null @@ -1,7 +0,0 @@ -/* $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 deleted file mode 100644 index ab842f843..000000000 --- a/util/opt/backward.c +++ /dev/null @@ -1,187 +0,0 @@ -#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 deleted file mode 100644 index d4525d4a4..000000000 --- a/util/opt/cleanup.c +++ /dev/null @@ -1,65 +0,0 @@ -#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 deleted file mode 100644 index 79767b296..000000000 --- a/util/opt/ext.h +++ /dev/null @@ -1,16 +0,0 @@ -/* $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 deleted file mode 100644 index 2f7d79add..000000000 --- a/util/opt/flow.c +++ /dev/null @@ -1,126 +0,0 @@ -#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 deleted file mode 100644 index d1080f9c5..000000000 --- a/util/opt/getline.c +++ /dev/null @@ -1,556 +0,0 @@ -#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 deleted file mode 100644 index d24237da5..000000000 --- a/util/opt/line.h +++ /dev/null @@ -1,88 +0,0 @@ -/* $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 deleted file mode 100644 index d6126e34d..000000000 --- a/util/opt/lookup.c +++ /dev/null @@ -1,94 +0,0 @@ -#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 deleted file mode 100644 index 0d36e3b41..000000000 --- a/util/opt/lookup.h +++ /dev/null @@ -1,25 +0,0 @@ -/* $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 deleted file mode 100644 index 11b274fd7..000000000 --- a/util/opt/main.c +++ /dev/null @@ -1,77 +0,0 @@ -#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 deleted file mode 100755 index 31e2e20da..000000000 --- a/util/opt/makedepend +++ /dev/null @@ -1,15 +0,0 @@ -: '$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 deleted file mode 100644 index f5bffa8aa..000000000 --- a/util/opt/mktab.y +++ /dev/null @@ -1,366 +0,0 @@ -%{ -#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 deleted file mode 100644 index d59e4375f..000000000 --- a/util/opt/optim.h +++ /dev/null @@ -1,12 +0,0 @@ -/* $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 deleted file mode 100644 index 167d12657..000000000 --- a/util/opt/param.h +++ /dev/null @@ -1,15 +0,0 @@ -/* $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 deleted file mode 100644 index e22119348..000000000 --- a/util/opt/pattern.h +++ /dev/null @@ -1,126 +0,0 @@ -/* $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 deleted file mode 100644 index 163eb792e..000000000 --- a/util/opt/patterns +++ /dev/null @@ -1,475 +0,0 @@ -/* $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 deleted file mode 100644 index 1a52beea7..000000000 --- a/util/opt/peephole.c +++ /dev/null @@ -1,652 +0,0 @@ -#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 deleted file mode 100644 index 0c763d847..000000000 --- a/util/opt/process.c +++ /dev/null @@ -1,185 +0,0 @@ -#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 deleted file mode 100644 index 0813fef13..000000000 --- a/util/opt/proinf.h +++ /dev/null @@ -1,36 +0,0 @@ -/* $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 deleted file mode 100644 index cc152bca1..000000000 --- a/util/opt/putline.c +++ /dev/null @@ -1,379 +0,0 @@ -#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 deleted file mode 100644 index 643fb9539..000000000 --- a/util/opt/reg.c +++ /dev/null @@ -1,101 +0,0 @@ -#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 deleted file mode 100644 index 834f9cf6b..000000000 --- a/util/opt/scan.l +++ /dev/null @@ -1,76 +0,0 @@ -%{ -#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 deleted file mode 100644 index 5147aa904..000000000 --- a/util/opt/special.c +++ /dev/null @@ -1,33 +0,0 @@ -#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 deleted file mode 100755 index 02f32f083..000000000 --- a/util/opt/testopt +++ /dev/null @@ -1,8 +0,0 @@ -: '$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 deleted file mode 100644 index 9b9462194..000000000 --- a/util/opt/types.h +++ /dev/null @@ -1,21 +0,0 @@ -/* $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 deleted file mode 100644 index 85529cdcc..000000000 --- a/util/opt/util.c +++ /dev/null @@ -1,62 +0,0 @@ -#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 deleted file mode 100644 index 9d5be0a58..000000000 --- a/util/opt/var.c +++ /dev/null @@ -1,40 +0,0 @@ -#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 */