Parcourir la source

artificial commit to compensate for changes in 93f3093f2b7e from a CVS
vendor branch

keie il y a 40 ans
Parent
commit
abde37e1fc
100 fichiers modifiés avec 19647 ajouts et 0 suppressions
  1. 44 0
      lang/pc/pem/Makefile
  2. 20 0
      lang/pc/pem/move.c
  3. 3138 0
      lang/pc/pem/pem.p
  4. 27 0
      lib/6500/descr
  5. 31 0
      lib/6809/descr
  6. 25 0
      lib/descr/cpm
  7. 60 0
      lib/descr/fe.src
  8. 35 0
      lib/descr/ibm.nosid
  9. 34 0
      lib/descr/m68k2.macs
  10. 28 0
      lib/descr/nascom
  11. 32 0
      lib/descr/net86
  12. 33 0
      lib/descr/sat86
  13. 27 0
      lib/em22/descr
  14. 27 0
      lib/i80/descr
  15. 32 0
      lib/i86/descr
  16. 30 0
      lib/m68k2/descr
  17. 34 0
      lib/m68k4/descr
  18. 38 0
      lib/pdp/descr
  19. 32 0
      lib/pmds/descr
  20. 44 0
      lib/vax4/descr.src
  21. 31 0
      lib/z80/descr
  22. 31 0
      lib/z8000/descr
  23. 178 0
      mach/6500/cg/Makefile
  24. 178 0
      mach/pdp/cg/Makefile
  25. 171 0
      mach/pdp/cg/mach.c
  26. 23 0
      mach/pdp/cg/mach.h
  27. 2450 0
      mach/pdp/cg/table
  28. 178 0
      mach/proto/cg/Makefile
  29. 7 0
      mach/proto/cg/assert.h
  30. 672 0
      mach/proto/cg/codegen.c
  31. 364 0
      mach/proto/cg/compute.c
  32. 54 0
      mach/proto/cg/data.h
  33. 105 0
      mach/proto/cg/equiv.c
  34. 8 0
      mach/proto/cg/equiv.h
  35. 49 0
      mach/proto/cg/extern.h
  36. 644 0
      mach/proto/cg/fillem.c
  37. 194 0
      mach/proto/cg/gencode.c
  38. 52 0
      mach/proto/cg/glosym.c
  39. 9 0
      mach/proto/cg/glosym.h
  40. 84 0
      mach/proto/cg/main.c
  41. 110 0
      mach/proto/cg/move.c
  42. 131 0
      mach/proto/cg/nextem.c
  43. 19 0
      mach/proto/cg/param.h
  44. 175 0
      mach/proto/cg/reg.c
  45. 151 0
      mach/proto/cg/regvar.c
  46. 19 0
      mach/proto/cg/regvar.h
  47. 19 0
      mach/proto/cg/result.h
  48. 150 0
      mach/proto/cg/salloc.c
  49. 104 0
      mach/proto/cg/state.c
  50. 24 0
      mach/proto/cg/state.h
  51. 547 0
      mach/proto/cg/subr.c
  52. 33 0
      mach/proto/cg/types.h
  53. 41 0
      mach/proto/cg/var.c
  54. 178 0
      mach/vax4/cg/Makefile
  55. 178 0
      mach/z80/cg/Makefile
  56. 178 0
      mach/z8000/cg/Makefile
  57. 23 0
      util/ack/.distr
  58. 63 0
      util/ack/Makefile
  59. 88 0
      util/ack/ack.h
  60. 9 0
      util/ack/data.c
  61. 43 0
      util/ack/data.h
  62. 15 0
      util/ack/dmach.h
  63. 94 0
      util/ack/files.c
  64. 79 0
      util/ack/grows.c
  65. 19 0
      util/ack/grows.h
  66. 73 0
      util/ack/list.c
  67. 23 0
      util/ack/list.h
  68. 340 0
      util/ack/main.c
  69. 208 0
      util/ack/malloc.c
  70. 121 0
      util/ack/mktables.c
  71. 2 0
      util/ack/pc/.distr
  72. 25 0
      util/ack/pc/Makefile
  73. 681 0
      util/ack/pc/em_pc.c
  74. 154 0
      util/ack/run.c
  75. 244 0
      util/ack/scan.c
  76. 125 0
      util/ack/svars.c
  77. 672 0
      util/ack/trans.c
  78. 30 0
      util/ack/trans.h
  79. 190 0
      util/ack/util.c
  80. 30 0
      util/cgg/Makefile
  81. 2317 0
      util/cgg/bootgram.y
  82. 189 0
      util/cgg/bootlex.l
  83. 202 0
      util/opt/Makefile
  84. 448 0
      util/opt/alloc.c
  85. 55 0
      util/opt/alloc.h
  86. 7 0
      util/opt/assert.h
  87. 187 0
      util/opt/backward.c
  88. 65 0
      util/opt/cleanup.c
  89. 16 0
      util/opt/ext.h
  90. 126 0
      util/opt/flow.c
  91. 556 0
      util/opt/getline.c
  92. 88 0
      util/opt/line.h
  93. 94 0
      util/opt/lookup.c
  94. 25 0
      util/opt/lookup.h
  95. 77 0
      util/opt/main.c
  96. 15 0
      util/opt/makedepend
  97. 366 0
      util/opt/mktab.y
  98. 12 0
      util/opt/optim.h
  99. 15 0
      util/opt/param.h
  100. 126 0
      util/opt/pattern.h

+ 44 - 0
lang/pc/pem/Makefile

@@ -0,0 +1,44 @@
+# $Header$
+d=../../..
+h=$d/h
+PEM=$d/lib/pc_pem
+PEM_OUT=$d/lib/pc_pem.out
+
+HEAD=$h/em_spec.h $h/em_pseu.h $h/em_mnem.h $h/em_mes.h $h/pc_size.h
+LDFLAG=-i
+
+all:            pem pem.out
+
+pem.out:        pem.m
+		apc -mint --t -o pem.out pem.m
+
+pem:            pem.m
+		apc $(LDFLAG) -o pem pem.m
+
+# pem.m is system dependent and may NOT be distributed
+pem.m:          pem.p $(HEAD)
+		-rm -f pem.m
+		-if apc -I$h -O -c.m pem.p ; then :; else \
+			acc -o move move.c ; move ; rm move move.[oskm] ; \
+		fi
+
+cmp:		pem
+		cmp pem $(PEM)
+
+install:	pem
+		cp pem $(PEM)
+
+distr:
+		ln pem.p pem22.p ; apc -mpdp -c.m -I$h pem22.p ; rm pem22.p
+		ln pem.p pem24.p ; apc -mvax2 -c.m -I$h pem24.p ; rm pem24.p
+clean:
+		-rm -f pem pem.out *.[os] *.old
+
+pr:
+		@pr pem.p
+
+xref:
+		xref pem.p^pr -h "XREF PEM.P"
+
+opr:
+		make pr ^ opr

+ 20 - 0
lang/pc/pem/move.c

@@ -0,0 +1,20 @@
+/* A program to move the file pem??.m to pem.m */
+/* Called when "apc pem.p" fails. It is assumed that the binary
+   file is incorrect in that case and has to be created from the compact
+   code file.
+   This program selects the correct compact code file for each combination
+   of word and pointer size.
+   It will return an error code if the move failed
+*/
+main(argc) {
+	char copy[100] ;
+
+	if ( argc!=1 ) {
+		printf("No arguments allowed\n") ;
+		exit(1) ;
+	}
+
+	sprintf(copy,"cp pem%d%d.m pem.m", EM_WSIZE, EM_PSIZE) ;
+	printf("%s\n",copy) ;
+	return system(copy) ;
+}

+ 3138 - 0
lang/pc/pem/pem.p

@@ -0,0 +1,3138 @@
+#include        <em_spec.h>
+#include        <em_pseu.h>
+#include        <em_mnem.h>
+#include        <em_mes.h>
+#include	<em_reg.h>
+#include        <pc_size.h>
+
+{
+  (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ 
+           This product is part of the Amsterdam Compiler Kit.
+ 
+  Permission to use, sell, duplicate or disclose this software must be
+  obtained in writing. Requests for such permissions may be sent to
+ 
+       Dr. Andrew S. Tanenbaum
+       Wiskundig Seminarium
+       Vrije Universiteit
+       Postbox 7161
+       1007 MC Amsterdam
+       The Netherlands
+ 
+}
+
+{if next line is included the compiler itself is written in standard pascal}
+{#define        STANDARD        1}
+
+{Author:        Johan Stevenson                 Version:        32}
+{$l- : no source line numbers}
+{$r- : no subrange checking}
+{$a- : no assertion checking}
+#ifdef STANDARD
+{$s+ : test conformancy to standard}
+#endif
+
+program pem(input,em,errors);
+{ This Pascal compiler produces EM code as described in
+   - A.S.Tanenbaum, J.W.Stevenson & H. van Staveren,
+	"Description of a machine architecture for use with
+	 block structured languages" Informatika rapport 81.
+  NOTE: this version is modified to produce the modified EM code of
+	januari 1981. it is not possible, using this compiler, to generate
+	code for machines with 1 or 4 byte wordsize.
+  A description of Pascal is given in
+   - K.Jensen & N.Wirth, "PASCAL user manual and report", Springer-Verlag.
+  Several options may be given in the normal pascal way. Moreover,
+  a positive number may be used instead of + and -. The options are:
+	a:      interpret assertions (+)
+	c:      C-type strings allowed (-)
+	d:      type long may be used (-)
+	i:      controls the number of bits in integer sets (16)
+	l:      insert code to keep track of source lines (+)
+	o:      optimize (+)
+	r:      check subranges (+)
+	s:      accept only standard pascal programs (-)
+	t:      trace procedure entry and exit (-)
+	u:      treat '_' as letter (-)
+}
+{===================================================================}
+#ifdef STANDARD
+label 9999;
+#endif
+
+const
+{fundamental constants}
+  MB1 = 7;               MB2 = 15;              {MB4 = 31}
+  NB1 = 8;               NB2 = 16;              {NB4 = 32}
+
+  MI1 = 127;             MI2 = 32767;           {MI4 = 2147483647}
+  NI1 = 128;            {NI2 = 32768}           {NI4 = 2147483648}
+
+  MU1 = 255;            {MU2 = 65535}           {MU4 = 4294967295}
+  NU1 = 256;            {NU2 = 65536}           {NU4 = 4294967296}
+
+{maximal indices}
+  idmax         = 8;
+  fnmax         = 14;
+  smax          = 72;
+
+{opt values}
+  off           = 0;
+  on            = 1;
+
+{for push and pop: }
+  global        = false;
+  local         = true;
+
+{for sizeof and posaddr: }
+  wordmult      = false;
+  wordpart      = true;
+
+{ASCII characters}
+  ascht         = 9;
+  ascnl         = 10;
+  ascvt         = 11;
+  ascff         = 12;
+  asccr         = 13;
+
+{miscellaneous}
+  maxcharord    = 127;          {maximal ordinal number of chars}
+  maxargc       = 13;           {maximal index in argv}
+  rwlim         = 34;           {number of reserved words}
+  spaces        = '        ';
+
+{-------------------------------------------------------------------}
+type
+{scalar types}
+  symbol=       (comma,semicolon,colon1,colon2,notsy,lbrack,ident,
+		 intcst,charcst,realcst,longcst,stringcst,nilcst,minsy,
+		 plussy,lparent,arrow,arraysy,recordsy,setsy,filesy,
+		 packedsy,progsy,labelsy,constsy,typesy,varsy,procsy,
+		 funcsy,beginsy,gotosy,ifsy,whilesy,repeatsy,forsy,
+		 withsy,casesy,becomes,starsy,divsy,modsy,slashsy,
+		 andsy,orsy,eqsy,nesy,gtsy,gesy,ltsy,
+		 lesy,insy,endsy,elsesy,untilsy,ofsy,dosy,
+		 downtosy,tosy,thensy,rbrack,rparent,period
+		);                      {the order is important}
+  chartype=     (lower,upper,digit,layout,tabch,
+		   quotech,dquotech,colonch,periodch,lessch,
+		   greaterch,lparentch,lbracech,
+						{different entries}
+		 rparentch,lbrackch,rbrackch,commach,semich,arrowch,
+		   plusch,minch,slash,star,equal,
+						{also symbols}
+		 others
+		);
+  standpf=      (pread,preadln,pwrite,pwriteln,pput,pget,
+		 preset,prewrite,pnew,pdispose,ppack,punpack,
+		 pmark,prelease,ppage,phalt,
+						{all procedures}
+		 feof,feoln,fabs,fsqr,ford,fchr,fpred,fsucc,fodd,
+		 ftrunc,fround,fsin,fcos,fexp,fsqt,flog,fatn
+						{all functions}
+		);                      {the order is important}
+  libmnem=      (ELN ,EFL ,CLS ,WDW ,           {input and output}
+		 OPN ,GETX,RDI ,RDC ,RDR ,RDL ,RLN ,
+						{on inputfiles}
+		 CRE ,PUTX,WRI ,WSI ,WRC ,WSC ,WRS ,WSS ,WRB ,
+		 WSB ,WRR ,WSR ,WRL, WSL, WRF ,WRZ ,WSZ ,WLN ,PAG ,
+				{on outputfiles, order important}
+		 ABR ,RND ,SINX,COSX,EXPX,SQT ,LOG ,ATN ,
+						{floating point}
+		 ABI ,ABL ,BCP ,BTS ,NEWX,SAV ,RST ,INI ,HLT ,
+		 ASS ,GTO ,PAC ,UNP, DIS, ASZ, MDI, MDL
+						{miscellaneous}
+		);
+  structform=   (scalar,subrange,pointer,power,files,arrays,carray,
+		 records,variant,tag);          {order important}
+  structflag=   (spack,withfile);
+  identflag=    (refer,used,assigned,noreg,loopvar,samesect);
+  idclass=      (types,konst,vars,field,carrbnd,proc,func);
+  kindofpf=     (standard,formal,actual,extern,varargs,forward);
+  where=        (blck,rec,wrec);
+  attrkind=     (cst,fixed,pfixed,loaded,ploaded,indexed);
+  twostruct=    (eq,subeq,ir,ri,il,li,lr,rl,es,se,noteq);  {order important}
+
+{subrange types}
+  rwrange=      0..rwlim;
+  byte=         0..MU1;
+
+{pointer types}
+  sp=   ^structure;
+  ip=   ^identifier;
+  lp=   ^labl;
+  bp=   ^blockinfo;
+  np=   ^nameinfo;
+
+{set types}
+  sos=          set of symbol;
+  setofids=     set of idclass;
+  formset=      set of structform;
+  sflagset=     set of structflag;
+  iflagset=     set of identflag;
+
+{array types}
+  idarr=packed array[1..idmax] of char;
+  fnarr=packed array[1..fnmax] of char;
+
+{record types}
+  position=record               {the addr info of certain variable}
+    ad:integer;                 {for locals it is the byte offset}
+    lv:integer;                 {the level of the beast}
+  end;
+
+{records of type attr are used to remember qualities of
+  expression parts to delay the loading of them.
+  Reasons to delay the loading of one word constants:
+	- bound checking
+	- set building.
+  Reasons to delay the loading of direct accessible objects:
+	- efficient handling of read/write
+	- efficient handling of the with statement.
+}
+  attr=record
+    asp:sp;                             {type of expression}
+    packbit:boolean;                    {true for part of packed structure}
+    ak:attrkind;                        {access method}
+    pos:position;                       {lv and ad}
+    {If ak=cst then the value is stored in ad}
+  end;
+
+  nameinfo=record               {one for each separate name space}
+    nlink:np;                   {one deeper}
+    fname:ip;                   {first name: root of tree}
+    case occur:where of
+      blck:();
+      rec: ();
+      wrec:(wa:attr)            {name space opened by with statement}
+  end;
+
+  blockinfo=record      {all info of the current procedure}
+    nextbp:bp;          {pointer to blockinfo of surrounding proc}
+    reglb:integer;      {data location counter (from begin of proc) }
+    minlb:integer;      {keeps track of minimum of reglb}
+    ilbno:integer;      {number of last local label}
+    forwcount:integer;  {number of not yet specified forward procs}
+    lchain:lp;          {first label: header of chain}
+  end;
+
+  structure=record
+    size:integer;                       {size of structure in bytes}
+    sflag:sflagset;                     {flag bits}
+    case form:structform of
+      scalar  :(scalno:integer;         {number of range descriptor}
+		fconst:ip               {names of constants}
+	       );
+      subrange:(min,max:integer;        {lower and upper bound}
+		rangetype:sp;           {type of bounds}
+		subrno:integer          {number of subr descriptor}
+	       );
+      pointer :(eltype:sp);             {type of pointed object}
+      power   :(elset:sp);              {type of set elements}
+      files   :(filtype:sp);            {type of file elements}
+      arrays,carray:
+	       (aeltype:sp;             {type of array elements}
+		inxtype:sp;             {type of array index}
+		arpos:position          {position of array descriptor}
+	       );
+      records :(fstfld:ip;              {points to first field}
+		tagsp:sp                {points to tag if present}
+	       );
+      variant :(varval:integer;         {tag value for this variant}
+		nxtvar:sp;              {next equilevel variant}
+		subtsp:sp               {points to tag for sub-case}
+	       );
+      tag     :(fstvar:sp;              {first variant of case}
+		tfldsp:sp               {type of tag}
+	       )
+  end;
+
+  identifier=record
+    idtype:sp;                          {type of identifier}
+    name:idarr;                         {name of identifier}
+    llink,rlink:ip;                     {see enterid,searchid}
+    next:ip;                            {used to make several chains}
+    iflag:iflagset;                     {several flag bits}
+    case klass:idclass of
+      types   :();
+      konst   :(value:integer);         {for integers the value is
+		  computed and stored in this field.
+		  For strings and reals an assembler constant is
+		  defined labeled '.1', '.2', ...  This '.' number is then
+		  stored in value. For reals value may be negated to
+		  indicate that the opposite of the assembler constant
+		  is needed. }
+      vars    :(vpos:position);         {position of var}
+      field   :(foffset:integer);       {offset to begin of record}
+      carrbnd :();                      {idtype points to carray struct}
+      proc,func:
+	(case pfkind:kindofpf of
+	   standard:(key:standpf);      {identification}
+	   formal,actual,forward,extern,varargs:
+	     (pfpos:position;           {lv gives declaration level.
+			ad is relevant for formal pf's and for
+			functions (no conflict!!).
+			for functions: ad is the result address.
+			for formal pf's: ad is the address of the
+			descriptor }
+	      pfno:integer;             {unique pf number}
+	      maxlb:integer;		{bytes of parameters}
+	      parhead:ip                {head of parameter list}
+	     )
+	)
+  end;
+
+  labl=record
+    nextlp:lp;          {chain of labels}
+    seen:boolean;
+    labval:integer;     {label number given by the programmer}
+    labname:integer;    {label number given by the compiler}
+    labdlb:integer      {zero means only locally used,
+			  otherwise dlbno of label information}
+  end;
+
+{-------------------------------------------------------------------}
+var  {the most frequent used externals are declared first}
+  sy:symbol;            {last symbol}
+  a:attr;               {type,access method,position,value of expr}
+{returned by insym}
+  ch:char;              {last character}
+  chsy:chartype;        {type of ch, used by insym}
+  val:integer;          {if last symbol is an constant }
+  ix:integer;           {string length}
+  eol:boolean;          {true of current ch is a space, replacing a newline}
+  zerostring:boolean;   {true for strings in " "}
+  id:idarr;             {if last symbol is an identifier}
+{some counters}
+  lino:integer;         {line number on code file (1..n) }
+  dlbno:integer;        {number of last global number}
+  holeb:integer;        {size of hol-area}
+  level:integer;        {current static level}
+  argc:integer;         {index in argv}
+  lastpfno:integer;     {unique pf number counter}
+  copt:integer;         {C-type strings allowed if on}
+  dopt:integer;         {longs allowed if on}
+  iopt:integer;         {number of bits in sets with base integer}
+  sopt:integer;         {standard option}
+  srcchno:integer;      {column count for errors}
+  srclino:integer;      {source line number after preprocessing}
+  srcorig:integer;      {source line number before preprocessing}
+  fildlb:integer;       {label number of source string}
+{pointers pointing to standard types}
+  realptr,intptr,textptr,nullset,boolptr:sp;
+  charptr,nilptr,zeroptr,procptr,longptr:sp;
+{flags}
+  giveline:boolean;     {give source line number at next statement}
+  including:boolean;    {no LIN's for included code}
+  eofexpected:boolean;  {quit without error if true (nextch) }
+  main:boolean;         {complete programme or a module}
+  intypedec:boolean;    {true if nested in typedefinition}
+  fltused:boolean;      {true if floating point instructions are used}
+  seconddot:boolean;    {indicates the second dot of '..'}
+{pointers}
+  fwptr:ip;             {head of chain of forward reference pointers}
+  progp:ip;             {program identifier}
+  currproc:ip;          {current procedure/function ip (see selector)}
+  top:np;               {pointer to the most recent name space}
+  lastnp:np;            {pointer to nameinfo of last searched ident }
+{records}
+  b:blockinfo;          {all info to be stacked at pfdeclaration}
+  fa:attr;              {attr for current file name}
+{arrays}
+  sizes:array[0 .. sz_last] of integer;
+  strbuf:array[1..smax] of char;
+  rw:array[rwrange] of idarr;
+			{reserved words}
+  frw:array[0..idmax] of integer;
+			{indices in rw}
+  rsy:array[rwrange] of symbol;
+			{symbol for reserved words}
+  cs:array[char] of chartype;
+			{chartype of a character}
+  csy:array[rparentch..equal] of symbol;
+			{symbol for single character symbols}
+  lmn:array[libmnem] of packed array[1..4] of char;
+			{mnemonics of pascal library routines}
+  opt:array['a'..'z'] of integer;
+  forceopt:array['a'..'z'] of boolean;
+			{26 different options}
+  undefip:array[idclass] of ip;
+			{used in searchid}
+  iop:array[boolean] of ip;
+			{false:standard input, true:standard output}
+  argv:array[0..maxargc] of
+	 record name:idarr; ad:integer end;
+			{save here the external heading names}
+{files}
+  em:file of byte;      {the EM code}
+  errors:text;          {the compilation errors}
+  source:fnarr;
+
+{===================================================================}
+
+procedure initpos(var p:position);
+begin p.lv:=level; p.ad:=0; end;
+
+procedure inita(fsp:sp; fad:integer);
+begin with a do begin
+  asp:=fsp; packbit:=false; ak:=fixed; pos.ad:=fad; pos.lv:=level;
+end end;
+
+function newip(kl:idclass; n:idarr; idt:sp; nxt:ip):ip;
+var p:ip; f:iflagset;
+begin f:=[];
+  case kl of
+    types,carrbnd:  {similar structure}
+      new(p,types);
+    konst:
+      begin new(p,konst); p^.value:=0 end;
+    vars:
+      begin new(p,vars); f:=[used,assigned]; initpos(p^.vpos) end;
+    field:
+      begin new(p,field); p^.foffset:=0 end;
+    proc,func:  {same structure}
+      begin new(p,proc,actual); p^.pfkind:=actual;
+	initpos(p^.pfpos); p^.pfno:=0; p^.maxlb:=0; p^.parhead:=nil;
+      end
+  end;
+  p^.name:=n; p^.klass:=kl; p^.idtype:=idt; p^.next:=nxt;
+  p^.llink:=nil; p^.rlink:=nil; p^.iflag:=f; newip:=p
+end;
+
+function newsp(sf:structform; sz:integer):sp;
+var p:sp; sflag:sflagset;
+begin sflag:=[];
+  case sf of
+    scalar:
+      begin new(p,scalar); p^.scalno:=0; p^.fconst:=nil end;
+    subrange:
+      new(p,subrange);
+    pointer:
+      begin new(p,pointer); p^.eltype:=nil end;
+    power:
+      new(p,power);
+    files:
+      begin new(p,files); sflag:=[withfile] end;
+    arrays,carray:  {same structure}
+      new(p,arrays);
+    records:
+      new(p,records);
+    variant:
+      new(p,variant);
+    tag:
+      new(p,tag);
+  end;
+  p^.form:=sf; p^.size:=sz; p^.sflag:=sflag; newsp:=p;
+end;
+
+function sizeof(fsp:sp; partword:boolean):integer;
+var s:integer;
+begin if fsp=nil then s:=0 else s:=fsp^.size;
+  if s<>0 then
+    if partword and (s<sz_word) then
+      while sz_word mod s <> 0 do s:=s+1
+    else
+      while s mod sz_word <> 0 do s:=s+1;
+  sizeof:=s
+end;
+
+function formof(fsp:sp; forms:formset):boolean;
+begin if fsp=nil then formof:=false else formof:=fsp^.form in forms end;
+
+{===================================================================}
+
+procedure put1(b:byte);
+begin write(em,b) end;
+
+procedure put2(i:integer);
+var i1,i2:byte;
+begin
+  if i<0 then
+    begin i:=-(i+1); i1:=MU1 - i mod NU1; i2:=MU1 - i div NU1 end
+  else
+    begin i1:=i mod NU1; i2:=i div NU1 end;
+  put1(i1); put1(i2)
+end;
+
+procedure argend;
+begin put1(sp_cend) end;
+
+procedure argcst(i:integer);
+begin
+  if (i >= -sp_zcst0) and (i < sp_ncst0-sp_zcst0) then
+    put1(i + sp_zcst0 + sp_fcst0)
+  else
+    begin put1(sp_cst2); put2(i) end
+end;
+
+procedure argnil;
+begin put1(sp_icon); argcst(sz_addr); argcst(1); put1(ord('0')) end;
+
+procedure argilb(i:integer);
+begin
+  if i<=MU1 then
+    begin put1(sp_ilb1); put1(i) end
+  else
+    begin put1(sp_ilb2); put2(i) end
+end;
+
+procedure argdlb(i:integer);
+begin
+  if i<=MU1 then
+    begin put1(sp_dlb1); put1(i) end
+  else
+    begin put1(sp_dlb2); put2(i) end
+end;
+
+procedure argident(var a:idarr);
+var i,j:integer;
+begin i:=idmax;
+  while (a[i]=' ') and (i>1) do i:=i-1;
+  put1(sp_pnam); argcst(i);
+  for j:=1 to i do put1(ord(a[j]))
+end;
+
+procedure genop(b:byte);
+begin put1(b); lino:=lino+1 end;
+
+procedure gencst(b:byte; i:integer);
+begin genop(b); argcst(i) end;
+
+procedure gensp(m:libmnem; s:integer);
+var i:integer;
+begin genop(op_cal); put1(sp_pnam); argcst(4);
+  for i:=1 to 4 do put1(ord(lmn[m][i]));
+  gencst(op_asp,s)
+end;
+
+procedure genpnam(b:byte; fip:ip);
+var n:idarr; i,j:integer;
+begin
+  if fip^.pfpos.lv<=1 then n:=fip^.name else
+    begin n:='_       '; j:=1; i:=fip^.pfno;
+      while i<>0 do
+	begin j:=j+1; n[j]:=chr(i mod 10 + ord('0')); i:=i div 10 end;
+    end;
+  genop(b); argident(n)
+end;
+
+procedure genasp(m:byte);
+begin gencst(m,sizeof(a.asp,wordmult)) end;
+
+procedure genlin;
+begin giveline:=false;
+  if opt['l']<>off then if main then gencst(op_lin,srcorig)
+end;
+
+procedure genreg(sz,ad,regval:integer);
+begin gencst(ps_mes,ms_reg);
+  argcst(ad); argcst(sz); argcst(regval); argend
+end;
+
+procedure laedlb(d:integer);
+begin genop(op_lae); argdlb(d) end;
+
+procedure exchange(l1,l2:integer);
+var d1,d2:integer;
+begin d1:=l2-l1; d2:=lino-l2;
+  if (d1<>0) and (d2<>0) then
+    begin gencst(ps_exc,d1); argcst(d2) end
+end;
+
+procedure newilb(i:integer);
+begin lino:=lino+1;
+  if i<sp_nilb0 then put1(i+sp_filb0) else argilb(i)
+end;
+
+function newdlb:integer;
+begin lino:=lino+1; dlbno:=dlbno+1; argdlb(dlbno); newdlb:=dlbno end;
+
+function romstr(typ:byte; siz:integer):integer;
+var i:integer;
+begin romstr:=newdlb; genop(ps_rom);
+  put1(typ); if typ<>sp_scon then argcst(siz); argcst(ix);
+  for i:=1 to ix do put1(ord(strbuf[i])); argend
+end;
+
+{===================================================================}
+
+procedure error(err:integer);
+{as you will notice, all error numbers are preceded by '+' and '0' to
+  ease their renumbering in case of new errornumbers.
+}
+begin writeln(errors,err,srclino,srcchno);
+  if err>0 then begin gencst(ps_mes,ms_err); argend end
+end;
+
+procedure errid(err:integer; var id:idarr);
+begin write(errors,'''',id); error(err) end;
+
+procedure errint(err:integer; i:integer);
+begin write(errors,i:1); error(err) end;
+
+procedure errasp(err:integer);
+begin if a.asp<>nil then begin error(err); a.asp:=nil end end;
+
+procedure teststandard;
+begin if sopt<>off then error(-(+01)) end;
+
+procedure enterid(fip: ip);
+{enter id pointed at by fip into the name-table,
+  which on each declaration level is organised as
+  an unbalanced binary tree}
+var nam:idarr; lip,lip1:ip; lleft,again:boolean;
+begin nam:=fip^.name; again:=false; assert nam[1]<>' ';
+  lip:=top^.fname;
+  if lip=nil then top^.fname:=fip else
+    begin
+      repeat lip1:=lip;
+	if lip^.name>nam then
+	  begin lip:=lip^.llink; lleft:=true end
+	else
+	  begin if lip^.name=nam then again:=true;  {name conflict}
+	    lip:=lip^.rlink; lleft:=false;
+	  end;
+      until lip=nil;
+      if lleft then lip1^.llink:=fip else lip1^.rlink:=fip
+    end;
+  fip^.llink:=nil; fip^.rlink:=nil;
+  if again then errid(+02,nam);
+end;
+
+{===================================================================}
+
+procedure trace(tname:idarr; fip:ip; var namdlb:integer);
+var i:integer;
+begin
+  if opt['t']<>off then
+    begin
+      if namdlb=0 then
+	begin namdlb:=newdlb; genop(ps_rom); put1(sp_scon); argcst(8);
+	  for i:=1 to 8 do put1(ord(fip^.name[i])); argend;
+	end;
+      laedlb(namdlb); genop(op_cal); argident(tname);
+      gencst(op_asp,sz_addr);
+    end;
+end;
+
+procedure expandnullset(fsp:sp);
+var s:integer;
+begin s:=sizeof(fsp,wordmult)-sz_word;
+  if s<>0 then gencst(op_zer,s); a.asp:=fsp
+end;
+
+procedure push(local:boolean; ad:integer; sz:integer);
+begin assert sz mod sz_word = 0;
+  if sz=sz_word then
+    if local then gencst(op_lol,ad) else gencst(op_loe,ad)
+  else if sz=2*sz_word then
+    if local then gencst(op_ldl,ad) else gencst(op_lde,ad)
+  else
+    begin if local then gencst(op_lal,ad) else gencst(op_lae,ad);
+      gencst(op_loi,sz)
+    end
+end;
+
+procedure pop(local:boolean; ad:integer; sz:integer);
+begin assert sz mod sz_word = 0;
+  if sz=sz_word then
+    if local then gencst(op_stl,ad) else gencst(op_ste,ad)
+  else if sz=2*sz_word then
+    if local then gencst(op_sdl,ad) else gencst(op_sde,ad)
+  else
+    begin if local then gencst(op_lal,ad) else gencst(op_lae,ad);
+      gencst(op_sti,sz)
+    end
+end;
+
+procedure lexaddr(lv:integer; ad:integer);
+begin assert level>=lv;
+  if ad>=0 then gencst(op_lxa,level-lv) else gencst(op_lxl,level-lv);
+  gencst(op_adp,ad)
+end;
+
+procedure loadpos(var p:position; sz:integer);
+begin with p do
+  if lv<=0 then push(global,ad,sz) else
+  if lv=level then push(local,ad,sz) else
+    begin lexaddr(lv,ad); gencst(op_loi,sz) end;
+end;
+
+procedure descraddr(var p:position);
+begin if p.lv=0 then laedlb(p.ad) else loadpos(p,sz_addr) end;
+
+procedure loadaddr;
+begin with a,pos do begin
+  case ak of
+    fixed:
+      if lv<=0 then gencst(op_lae,ad) else
+      if lv=level then gencst(op_lal,ad) else lexaddr(lv,ad);
+    pfixed:
+      loadpos(pos,sz_addr);
+    ploaded:
+      ;
+    indexed:
+      gencst(op_aar,sz_word);
+  end;  {case}
+  ak:=ploaded;
+end end;
+
+procedure load;
+var sz:integer;
+begin with a do begin sz:=sizeof(asp,packbit);
+  if asp<>nil then
+    case ak of
+      cst:
+	gencst(op_loc,pos.ad);  {only one-word scalars}
+      fixed:
+	loadpos(pos,sz);
+      pfixed:
+	begin loadpos(pos,sz_addr); gencst(op_loi,sz) end;
+      loaded:
+	;
+      ploaded:
+	gencst(op_loi,sz);
+      indexed:
+	gencst(op_lar,sz_word);
+    end;  {case}
+  ak:=loaded;
+end end;
+
+procedure store;
+var sz:integer;
+begin with a,pos do begin sz:=sizeof(asp,packbit);
+  if asp<>nil then
+    case ak of
+      fixed:
+	if lv<=0 then pop(global,ad,sz) else
+	if level=lv then pop(local,ad,sz) else
+	  begin lexaddr(lv,ad); gencst(op_sti,sz) end;
+      pfixed:
+	begin loadpos(pos,sz_addr); gencst(op_sti,sz) end;
+      ploaded:
+	gencst(op_sti,sz);
+      indexed:
+	gencst(op_sar,sz_word);
+    end;  {case}
+end end;
+
+procedure fieldaddr(off:integer);
+begin with a do
+  if (ak=fixed) and not packbit then pos.ad:=pos.ad+off else
+    begin loadaddr; gencst(op_adp,off) end
+end;
+
+procedure loadcheap;
+begin if formof(a.asp,[arrays..records]) then loadaddr else load end;
+
+{===================================================================}
+
+procedure nextch;
+begin
+  eol:=eoln(input); read(input,ch); srcchno:=srcchno+1; chsy:=cs[ch];
+end;
+
+procedure nextln;
+begin
+  if eof(input) then
+    begin
+      if not eofexpected then error(+03) else
+	if fltused then begin gencst(ps_mes,ms_flt); argend end;
+#ifdef STANDARD
+      goto 9999
+#else
+      halt
+#endif
+    end;
+  srcchno:=0; srclino:=srclino+1;
+  if not including then
+    begin srcorig:=srcorig+1; giveline:=true end;
+end;
+
+procedure options(normal:boolean);
+var ci:char; i:integer;
+
+procedure getc;
+begin if normal then nextch else read(errors,ch) end;
+
+begin
+  repeat getc;
+    if (ch>='a') and (ch<='z') then
+      begin ci:=ch; getc; i:=0;
+	if ch='+' then begin i:=1; getc end else
+	if ch='-' then getc else
+	if cs[ch]=digit then
+	  repeat i:=i*10 + ord(ch) - ord('0'); getc;
+	  until cs[ch]<>digit
+	else i:=-1;
+	if i>=0 then
+	  if not normal then
+	    begin forceopt[ci]:=true; opt[ci]:=i end
+	  else
+	    if not forceopt[ci] then opt[ci]:=i;
+      end;
+  until ch<>',';
+end;
+
+procedure linedirective;
+var i:integer; fname:fnarr;
+begin
+  repeat nextch until (ch='"') or eol;
+  if eol then error(+04) else
+    begin nextch; i:=0;
+      while (ch<>'"') and not eol do
+	begin
+	  if ch='/' then i:=0 else
+	    begin i:=i+1; if i<=fnmax then fname[i]:=ch end;
+	  nextch
+	end;
+      while i<fnmax do begin i:=i+1; fname[i]:=' ' end;
+      including:=fname<>source; while not eol do nextch
+    end;
+end;
+
+procedure putdig;
+begin ix:=ix+1; if ix<=smax then strbuf[ix]:=ch; nextch end;
+
+procedure inident;
+label 1;
+var i,k:integer;
+begin k:=0; id:=spaces;
+  repeat
+    if chsy=upper then ch:=chr(ord(ch)-ord('A')+ord('a'));
+    if k<idmax then begin k:=k+1; id[k]:=ch end;
+    nextch
+  until chsy>digit;
+	{lower=0,upper=1,digit=2. ugly but fast}
+  for i:=frw[k-1] to frw[k] - 1 do
+    if rw[i]=id then
+      begin sy:=rsy[i]; goto 1 end;
+  sy:=ident;
+1:
+end;
+
+procedure innumber;
+label   1;
+const   imax = 10;
+	maxintstring    = '0000032767';
+	maxlongstring   = '2147483647';
+var     i,j:integer;
+	is:packed array[1..imax] of char;
+begin ix:=0; sy:=intcst; val:=0;
+  repeat putdig until chsy<>digit;
+  if (ch='.') or (ch='e') or (ch='E') then
+    begin
+      if ch='.' then
+	begin putdig;
+	  if ch='.' then
+	    begin seconddot:=true; ix:=ix-1; goto 1 end;
+	  if chsy<>digit then error(+05) else
+	    repeat putdig until chsy<>digit;
+	end;
+      if (ch='e') or (ch='E') then
+	begin putdig;
+	  if (ch='+') or (ch='-') then putdig;
+	  if chsy<>digit then error(+06) else
+	    repeat putdig until chsy<>digit;
+	end;
+      if ix>smax then begin error(+07); ix:=smax end;
+      sy:=realcst; fltused:=true; val:=romstr(sp_fcon,sz_real);
+    end;
+1:if (chsy=lower) or (chsy=upper) then teststandard;
+  if sy=intcst then
+    if ix>imax then error(+08) else
+      begin is:='0000000000'; i:=ix; j:=imax;
+	repeat is[j]:=strbuf[i]; j:=j-1; i:=i-1 until i=0;
+	if is<=maxintstring then
+	  repeat j:=j+1; val:=val*10 - ord('0') + ord(is[j]) until j=imax
+	else if (is<=maxlongstring) and (dopt<>off) then
+	  begin sy:=longcst; val:=romstr(sp_icon,sz_long) end
+	else error(+09)
+      end
+end;
+
+procedure instring(qc:char);
+begin ix:=0; zerostring:=qc='"';
+  repeat
+    repeat nextch; ix:=ix+1; if ix<=smax then strbuf[ix]:=ch;
+    until (ch=qc) or eol;
+    if ch=qc then nextch else error(+010);
+  until ch<>qc;
+  if not zerostring then
+    begin ix:=ix-1; if ix=0 then error(+011) end
+  else
+    begin strbuf[ix]:=chr(0); if copt=off then error(+012) end;
+  if (ix=1) and not zerostring then
+    begin sy:=charcst; val:=ord(strbuf[1]) end
+  else
+    begin if ix>smax then begin error(+013); ix:=smax end;
+      sy:=stringcst; val:=romstr(sp_scon,0);
+    end
+end;
+
+procedure incomment;
+var stopc:char;
+begin nextch; stopc:='}';
+  if ch='$' then options(true);
+  while (ch<>'}') and (ch<>stopc) do
+    begin stopc:='}'; if ch='*' then stopc:=')';
+      if eol then nextln; nextch
+    end;
+  if ch<>'}' then teststandard;
+  nextch
+end;
+
+procedure insym;
+  {read next basic symbol of source program and return its
+  description in the global variables sy, op, id, val and ix}
+label 1;
+begin
+1:case chsy of
+    tabch:
+      begin srcchno:=srcchno - srcchno mod 8 + 8; nextch; goto 1 end;
+    layout:
+      begin if eol then nextln; nextch; goto 1 end;
+    lower,upper: inident;
+    digit: innumber;
+    quotech,dquotech:
+      instring(ch);
+    colonch:
+      begin nextch;
+	if ch='=' then begin sy:=becomes; nextch end else sy:=colon1
+      end;
+    periodch:
+      begin nextch;
+	if seconddot then begin seconddot:=false; sy:=colon2 end else
+	if ch='.' then begin sy:=colon2; nextch end else sy:=period
+      end;
+    lessch:
+      begin nextch;
+	if ch='=' then begin sy:=lesy; nextch end else
+	if ch='>' then begin sy:=nesy; nextch end else sy:=ltsy
+      end;
+    greaterch:
+      begin nextch;
+	if ch='=' then begin sy:=gesy; nextch end else sy:=gtsy
+      end;
+    lparentch:
+      begin nextch;
+	if ch<>'*' then sy:=lparent else
+	  begin teststandard; incomment; goto 1 end;
+      end;
+    lbracech:
+      begin incomment; goto 1 end;
+    rparentch,lbrackch,rbrackch,commach,semich,arrowch,
+    plusch,minch,slash,star,equal:
+      begin sy:=csy[chsy]; nextch end;
+    others:
+      begin
+	if (ch='#') and (srcchno=1) then linedirective else
+	  begin error(+014); nextch end;
+	goto 1
+      end;
+  end {case}
+end;
+
+procedure nextif(fsy:symbol; err:integer);
+begin if sy=fsy then insym else error(-err) end;
+
+function find1(sys1,sys2:sos; err:integer):boolean;
+{symbol of sys1 expected. return true if sy in sys1}
+begin
+  if not (sy in sys1) then
+    begin error(err); while not (sy in sys1+sys2) do insym end;
+  find1:=sy in sys1
+end;
+
+function find2(sys1,sys2:sos; err:integer):boolean;
+{symbol of sys1+sys2 expected. return true if sy in sys1}
+begin
+  if not (sy in sys1+sys2) then
+    begin error(err); repeat insym until sy in sys1+sys2 end;
+  find2:=sy in sys1
+end;
+
+function find3(sy1:symbol; sys2:sos; err:integer):boolean;
+{symbol sy1 or one of sys2 expected. return true if sy1 found and skip it}
+begin find3:=true;
+  if not (sy in [sy1]+sys2) then
+    begin error(err); repeat insym until sy in [sy1]+sys2 end;
+  if sy=sy1 then insym else find3:=false
+end;
+
+function endofloop(sys1,sys2:sos; sy3:symbol; err:integer):boolean;
+begin endofloop:=false;
+  if find2(sys2+[sy3],sys1,err) then nextif(sy3,err+1)
+  else endofloop:=true;
+end;
+
+function lastsemicolon(sys1,sys2:sos; err:integer):boolean;
+begin lastsemicolon:=true;
+  if not endofloop(sys1,sys2,semicolon,err) then
+    if find2(sys2,sys1,err+2) then lastsemicolon:=false
+end;
+
+{===================================================================}
+
+function searchid(fidcls: setofids):ip;
+{search for current identifier symbol in the name table}
+label 1;
+var lip:ip; ic:idclass;
+begin lastnp:=top;
+  while lastnp<>nil do
+    begin lip:=lastnp^.fname;
+      while lip<>nil do
+	if lip^.name=id then
+	  if lip^.klass in fidcls then
+	    begin
+	      if lip^.klass=vars then if lip^.vpos.lv<>level then
+		lip^.iflag:=lip^.iflag+[noreg];
+	      goto 1
+	    end
+	  else lip:=lip^.rlink
+	else
+	  if lip^.name< id then lip:=lip^.rlink else lip:=lip^.llink;
+      lastnp:=lastnp^.nlink;
+    end;
+  errid(+015,id);
+  if types in fidcls then ic:=types else
+  if vars  in fidcls then ic:=vars  else
+  if konst in fidcls then ic:=konst else
+  if proc  in fidcls then ic:=proc  else
+  if func  in fidcls then ic:=func  else ic:=field;
+  lip:=undefip[ic];
+1:
+  searchid:=lip
+end;
+
+function searchsection(fip: ip):ip;
+{to find record fields and forward declared procedure id's
+  -->procedure pfdeclaration
+  -->procedure selector}
+label 1;
+begin
+  while fip<>nil do
+    if fip^.name=id then goto 1 else
+      if fip^.name< id then fip:=fip^.rlink else fip:=fip^.llink;
+1:  searchsection:=fip
+end;
+
+function searchlab(flp:lp; val:integer):lp;
+label 1;
+begin
+  while flp<>nil do
+    if flp^.labval=val then goto 1 else flp:=flp^.nextlp;
+1:searchlab:=flp
+end;
+
+procedure opconvert(ts:twostruct);
+var op:integer;
+begin with a do begin genasp(op_loc);
+  case ts of
+    ir, lr: begin asp:=realptr; op:=op_cif; fltused:=true end;
+    ri:     begin asp:=intptr ; op:=op_cfi; fltused:=true end;
+    rl:     begin asp:=longptr; op:=op_cfi; fltused:=true end;
+    li:     begin asp:=intptr ; op:=op_cii end;
+    il:     begin asp:=longptr; op:=op_cii end;
+  end;
+  genasp(op_loc); genop(op)
+end end;
+
+procedure negate;
+begin if a.asp=realptr then genasp(op_ngf) else genasp(op_ngi) end;
+
+function desub(fsp:sp):sp;
+begin if formof(fsp,[subrange]) then fsp:=fsp^.rangetype; desub:=fsp end;
+
+function nicescalar(fsp:sp):boolean;
+begin
+  if fsp=nil then nicescalar:=true else
+    nicescalar:=(fsp^.form=scalar) and (fsp<>realptr) and (fsp<>longptr)
+end;
+
+function bounded(fsp:sp):boolean;
+begin bounded:=false;
+  if fsp<>nil then
+    if fsp^.form=subrange then bounded:=true else
+    if fsp^.form=scalar then bounded:=fsp^.fconst<>nil
+end;
+
+procedure bounds(fsp:sp; var fmin,fmax:integer);
+begin
+  if fsp=nil then
+    begin fmin:=0; fmax:=0 end
+  else
+    case fsp^.form of
+    subrange:
+      begin fmin:=fsp^.min; fmax:=fsp^.max end;
+    scalar:
+      begin fmin:=0; fmax:=fsp^.fconst^.value end
+    end
+end;
+
+procedure genrck(fsp:sp);
+var min,max,sno:integer;
+begin
+  if opt['r']<>off then if bounded(fsp) then
+    begin
+      if fsp^.form=scalar then sno:=fsp^.scalno else sno:=fsp^.subrno;
+      if sno=0 then
+	begin bounds(fsp,min,max); sno:=newdlb;
+	  gencst(ps_rom,min); argcst(max); argend;
+	  if fsp^.form=scalar then fsp^.scalno:=sno else fsp^.subrno:=sno
+	end;
+      laedlb(sno); gencst(op_rck,sz_word);
+    end
+end;
+
+procedure checkbnds(fsp:sp);
+var min1,max1,min2,max2:integer;
+begin
+  if bounded(fsp) then
+    if not bounded(a.asp) then genrck(fsp) else
+      begin bounds(fsp,min1,max1); bounds(a.asp,min2,max2);
+	if (min2<min1) or (max2>max1) then
+	  genrck(fsp);
+      end;
+  a.asp:=fsp;
+end;
+
+function eqstruct(p,q:sp):boolean;
+begin eqstruct:=(p=q) or (p=nil) or (q=nil) end;
+
+function string(fsp:sp):boolean;
+var lsp:sp;
+begin string:=false;
+  if formof(fsp,[arrays]) then
+    if eqstruct(fsp^.aeltype,charptr) then
+      if spack in fsp^.sflag then
+	begin lsp:=fsp^.inxtype;
+	  if lsp=nil then string:=true else
+	    if lsp^.form=subrange then
+	      if lsp^.rangetype=intptr then
+		if lsp^.min=1 then
+		  string:=true
+	end
+end;
+
+function compat(p,q:sp):twostruct;
+begin compat:=noteq;
+  if eqstruct(p,q) then compat:=eq else
+    begin p:=desub(p); q:=desub(q);
+      if eqstruct(p,q) then compat:=subeq else
+      if p^.form=q^.form then
+	case p^.form of
+	  scalar:
+	    if (p=intptr) and (q=realptr) then compat:=ir else
+	    if (p=realptr) and (q=intptr) then compat:=ri else
+	    if (p=intptr) and (q=longptr) then compat:=il else
+	    if (p=longptr) and (q=intptr) then compat:=li else
+	    if (p=longptr) and (q=realptr) then compat:=lr else
+	    if (p=realptr) and (q=longptr) then compat:=rl else
+		;
+	  pointer:
+	    if (p=nilptr) or (q=nilptr) then compat:=eq;
+	  power:
+	    if p=nullset then compat:=es else
+	    if q=nullset then compat:=se else
+	    if compat(p^.elset,q^.elset) <= subeq then
+	      if p^.sflag=q^.sflag then compat:=eq;
+	  arrays:
+	    if string(p) and string(q) and (p^.size=q^.size) then compat:=eq;
+	  files,carray,records: ;
+	end;
+    end
+end;
+
+procedure checkasp(fsp:sp; err:integer);
+var ts:twostruct;
+begin
+  ts:=compat(a.asp,fsp);
+  case ts of
+    eq:
+      if fsp<>nil then if withfile in fsp^.sflag then errasp(err);
+    subeq:
+      checkbnds(fsp);
+    li:
+      begin opconvert(ts); checkasp(fsp,err) end;
+    il,rl,lr,ir:
+      opconvert(ts);
+    es:
+      expandnullset(fsp);
+    noteq,ri,se:
+      errasp(err);
+  end
+end;
+
+procedure force(fsp:sp; err:integer);
+begin load; checkasp(fsp,err) end;
+
+function newident(kl:idclass; idt:sp; nxt:ip; err:integer):ip;
+begin newident:=nil;
+  if sy<>ident then error(err) else
+    begin newident:=newip(kl,id,idt,nxt); insym end
+end;
+
+function stringstruct:sp;
+var lsp:sp;
+begin {only used when ix and zerostring are still valid}
+  if zerostring then lsp:=zeroptr else
+    begin lsp:=newsp(arrays,ix*sz_char); lsp^.sflag:=[spack];
+      lsp^.aeltype:=charptr; lsp^.inxtype:=nil;
+    end;
+  stringstruct:=lsp;
+end;
+
+function posaddr(var lb:integer; fsp:sp; partword:boolean):integer;
+var sz:integer;
+begin sz:=sizeof(fsp,partword);
+  if lb >= MI2-sz then begin error(+016); lb:=0 end;
+  if not partword or (sz>=sz_word) then
+    while lb mod sz_word <> 0 do lb:=lb+1;
+  posaddr:=lb;
+  lb:=lb+sz
+end;
+
+function negaddr(fsp:sp):integer;
+var sz:integer;
+begin with b do begin
+  sz:=sizeof(fsp,wordmult);
+  if reglb <= -MI2+sz then begin error(+017); reglb:=0 end;
+  reglb:=reglb-sz;
+  while reglb mod sz_word <> 0 do reglb:=reglb-1;
+  if reglb < minlb then minlb:=reglb;
+  negaddr:=reglb
+end end;
+
+procedure temporary(fsp:sp;r:integer);
+begin inita(fsp,negaddr(fsp));
+  if r>=0 then genreg(sizeof(fsp,wordmult),a.pos.ad,r)
+end;
+
+procedure genhol;
+begin gencst(ps_hol,posaddr(holeb,nil,false));
+  argcst(-MI2-1); argcst(0); level:=1
+end;
+
+function arraysize(fsp:sp; pack:boolean):integer;
+var sz,min,max,tot,n:integer;
+begin sz:=sizeof(fsp^.aeltype,pack);
+  bounds(fsp^.inxtype,min,max);
+  fsp^.arpos.lv:=0; fsp^.arpos.ad:=newdlb;
+  gencst(ps_rom,min); argcst(max-min); argcst(sz); argend;
+  n:=max-min+1; tot:=sz*n;
+  if sz<>0 then if tot div sz <> n then begin error(+018); tot:=0 end;
+  arraysize:=tot
+end;
+
+procedure treewalk(fip:ip);
+var lsp:sp; i,sz:integer;
+begin
+  if fip<>nil then
+    begin treewalk(fip^.llink); treewalk(fip^.rlink);
+      if fip^.klass=vars then
+	begin if not (used in fip^.iflag) then errid(-(+019),fip^.name);
+	  if not (assigned in fip^.iflag) then errid(-(+020),fip^.name);
+	  lsp:=fip^.idtype;
+	  if level<>1 then if not (noreg in fip^.iflag) then
+	    if (refer in fip^.iflag) or formof(lsp,[pointer]) then
+	      genreg(sz_addr,fip^.vpos.ad,reg_pointer)
+	    else
+	      begin sz:=sizeof(lsp,wordmult);
+		if loopvar in fip^.iflag then
+		  genreg(sz,fip^.vpos.ad,reg_loop)
+		else if lsp=realptr then
+		  genreg(sz,fip^.vpos.ad,reg_float)
+		else
+		  genreg(sz,fip^.vpos.ad,reg_any);
+	      end;
+	  if lsp<>nil then if withfile in lsp^.sflag then
+	    if lsp^.form=files then
+	      if level=1 then
+		begin
+		  for i:=2 to argc do with argv[i] do
+		    if name=fip^.name then ad:=fip^.vpos.ad
+		end
+	      else
+		begin
+		  if not (refer in fip^.iflag) then
+		    begin gencst(op_lal,fip^.vpos.ad); gensp(CLS,sz_addr)
+		    end
+		end
+	    else
+	      if level<>1 then errid(-(+021),fip^.name)
+	end
+    end
+end;
+
+procedure constant(fsys:sos; var fsp:sp; var fval:integer);
+var signed,min:boolean; lip:ip;
+begin signed:=(sy=plussy) or (sy=minsy);
+  if signed then begin min:=sy=minsy; insym end else min:=false;
+  if find1([ident..stringcst],fsys,+022) then
+    begin fval:=val;
+      case sy of
+	stringcst: fsp:=stringstruct;
+	charcst: fsp:=charptr;
+	intcst: fsp:=intptr;
+	realcst: fsp:=realptr;
+	longcst: fsp:=longptr;
+	ident:
+	  begin lip:=searchid([konst]);
+	    fsp:=lip^.idtype; fval:=lip^.value;
+	  end
+      end;  {case}
+      if signed then
+	if (fsp<>intptr) and (fsp<>realptr) and (fsp<>longptr) then
+	  error(+023)
+	else if min then fval:= -fval;
+		{note: negating the v-number for reals and longs}
+      insym;
+    end
+  else begin fsp:=nil; fval:=0 end;
+end;
+
+function cstinteger(fsys:sos; fsp:sp; err:integer):integer;
+var lsp:sp; lval,min,max:integer;
+begin constant(fsys,lsp,lval);
+  if fsp<>lsp then
+    if not eqstruct(desub(fsp),lsp) then
+      begin error(err); lval:=0 end
+    else if bounded(fsp) then
+      begin bounds(fsp,min,max);
+	if (lval<min) or (lval>max) then error(+024)
+      end;
+  cstinteger:=lval
+end;
+
+{===================================================================}
+
+function typid(err:integer):sp;
+var lip:ip; lsp:sp;
+begin lsp:=nil;
+  if sy<>ident then error(err) else
+    begin lip:=searchid([types]); lsp:=lip^.idtype; insym end;
+  typid:=lsp
+end;
+
+function simpletyp(fsys:sos):sp;
+var lsp,lsp1:sp; lip,hip:ip; min,max:integer; lnp:np;
+    newsubrange:boolean;
+begin lsp:=nil;
+  if find1([ident..lparent],fsys,+025) then
+    if sy=lparent then
+      begin insym; lnp:=top;   {decl. consts local to innermost block}
+	while top^.occur<>blck do top:=top^.nlink;
+	lsp:=newsp(scalar,sz_word); hip:=nil; max:=0;
+	repeat lip:=newident(konst,lsp,hip,+026);
+	  if lip<>nil then
+	    begin enterid(lip); hip:=lip; lip^.value:=max; max:=max+1 end;
+	until endofloop(fsys+[rparent],[ident],comma,+027);  {+028}
+	if max<=MU1 then lsp^.size:=sz_byte;
+	lsp^.fconst:=hip; top:=lnp; nextif(rparent,+029);
+      end
+    else
+      begin newsubrange:=true;
+	if sy=ident then
+	  begin lip:=searchid([types,konst]); insym;
+	    if lip^.klass=types then
+	      begin lsp:=lip^.idtype; newsubrange:=false end
+	    else
+	      begin lsp1:=lip^.idtype; min:=lip^.value end
+	  end
+	else constant(fsys+[colon2,ident..plussy],lsp1,min);
+	if newsubrange then
+	  begin lsp:=newsp(subrange,sz_word); lsp^.subrno:=0;
+	    if not nicescalar(lsp1) then
+	      begin error(+030); lsp1:=nil; min:=0 end;
+	    lsp^.rangetype:=lsp1;
+	    nextif(colon2,+031); max:=cstinteger(fsys,lsp1,+032);
+	    if min>max then begin error(+033); max:=min end;
+	    if (min>=0) and (max<=MU1) then lsp^.size:=sz_byte;
+	    lsp^.min:=min; lsp^.max:=max
+	  end
+      end;
+  simpletyp:=lsp
+end;
+
+function arraytyp(fsys:sos;
+		  artyp:structform;
+		  sflag:sflagset;
+		  function element(fsys:sos):sp
+		 ):sp;
+var lsp,lsp1,hsp:sp; ok:boolean; sepsy:symbol; lip:ip;
+    oksys:sos;
+begin insym; nextif(lbrack,+034); hsp:=nil;
+  repeat lsp:=newsp(artyp,0); initpos(lsp^.arpos);
+    lsp^.aeltype:=hsp; hsp:=lsp;  {link reversed}
+    if artyp=carray then
+      begin sepsy:=semicolon; oksys:=[ident];
+	lip:=newident(carrbnd,lsp,nil,+035); if lip<>nil then enterid(lip);
+	nextif(colon2,+036);
+	lip:=newident(carrbnd,lsp,lip,+037); if lip<>nil then enterid(lip);
+	nextif(colon1,+038); lsp1:=typid(+039);
+	ok:=nicescalar(desub(lsp1));
+      end
+    else
+      begin sepsy:=comma; oksys:=[ident..lparent];
+	lsp1:=simpletyp(fsys+[comma,rbrack,ofsy,ident..packedsy]);
+	ok:=bounded(lsp1)
+      end;
+    if not ok then begin error(+040); lsp1:=nil end;
+    lsp^.inxtype:=lsp1
+  until endofloop(fsys+[rbrack,ofsy,ident..packedsy],oksys,
+				sepsy,+041);  {+042}
+  nextif(rbrack,+043); nextif(ofsy,+044);
+  lsp:=element(fsys);
+  if lsp<>nil then sflag:=sflag + lsp^.sflag * [withfile];
+  repeat  {reverse links and compute size}
+    lsp1:=hsp^.aeltype; hsp^.aeltype:=lsp; hsp^.sflag:=sflag;
+    if artyp=arrays then hsp^.size:=arraysize(hsp,spack in sflag);
+    lsp:=hsp; hsp:=lsp1
+  until hsp=nil;  {lsp points to array with highest dimension}
+  arraytyp:=lsp
+end;
+
+function typ(fsys:sos):sp;
+var lsp,lsp1:sp; off,sz,min,errno:integer;
+    sflag:sflagset; lnp:np;
+
+function fldlist(fsys:sos):sp;
+	{level 2: <<  typ}
+var fip,hip,lip:ip; lsp:sp;
+
+function varpart(fsys:sos):sp;
+	{level 3: <<  fldlist <<  typ}
+var tip,lip:ip; lsp,headsp,hsp,vsp,tsp,tsp1,tfsp:sp;
+    minoff,maxoff,int,nvar:integer; lid:idarr;
+begin insym; tip:=nil; lip:=nil;
+  tsp:=newsp(tag,0);
+  if sy<>ident then error(+045) else
+    begin lid:=id; insym;
+      if sy=colon1 then
+	begin tip:=newip(field,lid,nil,nil); enterid(tip); insym;
+	  if sy<>ident then error(+046) else
+	    begin lid:=id; insym end;
+	end;
+      if sy=ofsy then  {otherwise you may destroy id}
+	begin id:=lid; lip:=searchid([types]) end;
+    end;
+  if lip=nil then tfsp:=nil else tfsp:=lip^.idtype;
+  if bounded(tfsp) then
+    begin bounds(tfsp,int,nvar); nvar:=nvar-int+1 end
+  else
+    begin nvar:=0; if tfsp<>nil then begin error(+047); tfsp:=nil end end;
+  tsp^.tfldsp:=tfsp;
+  if tip<>nil then  {explicit tag}
+    begin tip^.idtype:=tfsp;
+      tip^.foffset:=posaddr(off,tfsp,spack in sflag)
+    end;
+  nextif(ofsy,+048); minoff:=off; maxoff:=minoff; headsp:=nil;
+  repeat hsp:=nil;  {for each caselabel list}
+    repeat nvar:=nvar-1;
+      int:=cstinteger(fsys+[ident..plussy,comma,colon1,lparent,
+		    semicolon,casesy,rparent],tfsp,+049);
+      lsp:=headsp;  {each label may occur only once}
+      while lsp<>nil do
+	begin if lsp^.varval=int then error(+050);
+	  lsp:=lsp^.nxtvar
+	end;
+      vsp:=newsp(variant,0); vsp^.varval:=int;
+      vsp^.nxtvar:=headsp; headsp:=vsp;  {chain of case labels}
+      vsp^.subtsp:=hsp; hsp:=vsp;
+	    {use this field to link labels with same variant}
+    until endofloop(fsys+[colon1,lparent,semicolon,casesy,rparent],
+		    [ident..plussy],comma,+051);  {+052}
+    nextif(colon1,+053); nextif(lparent,+054);
+    tsp1:=fldlist(fsys+[rparent,semicolon,ident..plussy]);
+    if off>maxoff then maxoff:=off;
+    while vsp<>nil do
+      begin vsp^.size:=off; hsp:=vsp^.subtsp;
+	vsp^.subtsp:=tsp1; vsp:=hsp
+      end;
+    nextif(rparent,+055);
+    off:=minoff;
+  until lastsemicolon(fsys,[ident..plussy],+056);  {+057 +058}
+  if nvar>0 then error(-(+059));
+  tsp^.fstvar:=headsp; tsp^.size:=minoff; off:=maxoff; varpart:=tsp;
+end;
+
+begin  {fldlist}
+  if find2([ident],fsys+[casesy],+060) then
+    repeat lip:=nil; hip:=nil;
+      repeat fip:=newident(field,nil,nil,+061);
+	if fip<>nil then
+	  begin enterid(fip);
+	    if lip=nil then hip:=fip else lip^.next:=fip; lip:=fip;
+	  end;
+      until endofloop(fsys+[colon1,ident..packedsy,semicolon,casesy],
+			      [ident],comma,+062);  {+063}
+      nextif(colon1,+064);
+      lsp:=typ(fsys+[casesy,semicolon]);
+      if lsp<>nil then if withfile in lsp^.sflag then
+	sflag:=sflag+[withfile];
+      while hip<>nil do
+	begin hip^.idtype:=lsp;
+	  hip^.foffset:=posaddr(off,lsp,spack in sflag);
+	  hip:=hip^.next
+	end;
+    until lastsemicolon(fsys+[casesy],[ident],+065);  {+066 +067}
+  if sy=casesy then fldlist:=varpart(fsys) else fldlist:=nil;
+end;
+
+
+begin  {typ}
+  sflag:=[]; lsp:=nil;
+  if sy=packedsy then begin sflag:=[spack]; insym end;
+  if find1([ident..filesy],fsys,+068) then
+    if sy in [ident..arrow] then
+      begin if spack in sflag then error(+069);
+	if sy=arrow then
+	  begin lsp:=newsp(pointer,sz_addr); insym;
+	    if not intypedec then lsp^.eltype:=typid(+070) else
+	      if sy<>ident then error(+071) else
+		begin fwptr:=newip(types,id,lsp,fwptr); insym end
+	  end
+	else lsp:=simpletyp(fsys);
+      end
+    else
+      case sy of
+{<<<<<<<<<<<<}
+arraysy:
+  lsp:=arraytyp(fsys,arrays,sflag,typ);
+recordsy:
+  begin insym;
+    new(lnp,rec); lnp^.occur:=rec; lnp^.nlink:=top; lnp^.fname:=nil; top:=lnp;
+    off:=0; lsp1:=fldlist(fsys+[endsy]);  {fldlist updates off}
+    lsp:=newsp(records,off); lsp^.tagsp:=lsp1;
+    lsp^.fstfld:=top^.fname; lsp^.sflag:=sflag;
+    top:=top^.nlink; nextif(endsy,+072)
+  end;
+setsy:
+  begin insym; nextif(ofsy,+073);
+    lsp:=simpletyp(fsys); lsp1:=desub(lsp); errno:=0;
+    if bounded(lsp1) then
+      begin bounds(lsp1,min,sz);
+	if sz div NB1>=sz_mset then errno:=+074
+      end
+    else if bounded(lsp) then  {subrange of integer}
+      begin bounds(lsp,min,sz);
+	if (min<0) or (sz>=iopt) then errno:=+075;
+	sz:=iopt-1
+      end
+    else if lsp=intptr then
+      begin sz:=iopt-1; errno:=-(+076) end
+    else
+      errno:=+077;
+    if errno<>0 then
+      begin error(errno); if errno>0 then begin lsp1:=nil; sz:=0 end end;
+    lsp:=newsp(power,sz div NB1 +1); lsp^.elset:=lsp1;
+  end;
+filesy:
+  begin insym; nextif(ofsy,+078); lsp1:=typ(fsys);
+    if lsp1<>nil then if withfile in lsp1^.sflag then error(-(+079));
+    sz:=sizeof(lsp1,wordpart); if sz<sz_buff then sz:=sz_buff;
+    lsp:=newsp(files,sz+sz_head); lsp^.filtype:=lsp1;
+  end;
+{>>>>>>>>>>>>}
+      end;  {case}
+  typ:=lsp;
+end;
+
+function vpartyp(fsys:sos):sp;
+begin
+  if find2([arraysy],fsys+[ident],+080) then
+    vpartyp:=arraytyp(fsys,carray,[],vpartyp)
+  else
+    vpartyp:=typid(+081)
+end;
+
+{===================================================================}
+
+procedure block(fsys:sos; fip:ip); forward;
+	{pfdeclaration calls block. With a more obscure lexical
+	  structure this forward declaration can be avoided}
+
+procedure labeldeclaration(fsys:sos);
+var llp:lp;
+begin with b do begin
+  repeat
+    if sy<>intcst then error(+082) else
+      begin
+	if searchlab(lchain,val)<>nil then errint(+083,val) else
+	  begin new(llp); llp^.labval:=val;
+	    if val>9999 then teststandard;
+	    ilbno:=ilbno+1; llp^.labname:=ilbno; llp^.labdlb:=0;
+	    llp^.seen:=false; llp^.nextlp:=lchain; lchain:=llp;
+	  end;
+	insym
+      end
+  until endofloop(fsys+[semicolon],[intcst],comma,+084);  {+085}
+  nextif(semicolon,+086)
+end end;
+
+procedure constdefinition(fsys:sos);
+var lip:ip;
+begin
+  repeat lip:=newident(konst,nil,nil,+087);
+    if lip<>nil then
+      begin nextif(eqsy,+088);
+	constant(fsys+[semicolon,ident],lip^.idtype,lip^.value);
+	nextif(semicolon,+089); enterid(lip);
+      end;
+  until not find2([ident],fsys,+090);
+end;
+
+procedure typedefinition(fsys:sos);
+var lip:ip;
+begin fwptr:=nil; intypedec:=true;
+  repeat lip:=newident(types,nil,nil,+091);
+    if lip<>nil then
+      begin nextif(eqsy,+092);
+	lip^.idtype:=typ(fsys+[semicolon,ident]);
+	nextif(semicolon,+093); enterid(lip);
+      end;
+  until not find2([ident],fsys,+094);
+  while fwptr<>nil do
+    begin assert sy<>ident;
+      id:=fwptr^.name; lip:=searchid([types]);
+      fwptr^.idtype^.eltype:=lip^.idtype; fwptr:=fwptr^.next
+    end;
+  intypedec:=false;
+end;
+
+procedure vardeclaration(fsys:sos);
+var lip,hip,vip:ip; lsp:sp;
+begin with b do begin
+  repeat hip:=nil; lip:=nil;
+    repeat vip:=newident(vars,nil,nil,+095);
+      if vip<>nil then
+	begin enterid(vip); vip^.iflag:=[];
+	  if lip=nil then hip:=vip else lip^.next:=vip; lip:=vip;
+	end;
+    until endofloop(fsys+[colon1,ident..packedsy],[ident],comma,+096);  {+097}
+    nextif(colon1,+098);
+    lsp:=typ(fsys+[semicolon,ident]);
+    while hip<>nil do
+      begin hip^.idtype:=lsp;
+	if level<=1 then
+	  hip^.vpos.ad:=posaddr(holeb,lsp,false)
+	else
+	  hip^.vpos.ad:=negaddr(lsp);
+	hip:=hip^.next
+      end;
+    nextif(semicolon,+099);
+  until not find2([ident],fsys,+0100);
+end end;
+
+procedure pfhead(fsys:sos;var fip:ip;var again:boolean;param:boolean);
+  forward;
+
+procedure parlist(fsys:sos; slink:boolean; var tip:ip; var maxlb:integer);
+var lastip,hip,lip,pip:ip; lsp,tsp:sp; iflag:iflagset; again:boolean;
+begin tip:=nil; lastip:=nil;
+  maxlb:=0; if slink then maxlb:=sz_addr;
+  repeat  {once for each formal-parameter-section}
+    if find1([ident,varsy,procsy,funcsy],fsys+[semicolon],+0101) then
+      begin
+	if (sy=procsy) or (sy=funcsy) then
+	  begin
+	    pfhead(fsys+[semicolon,ident,varsy,procsy,funcsy],hip,again,true);
+	    hip^.pfpos.ad:=posaddr(maxlb,procptr,false);
+	    hip^.pfkind:=formal; lip:=hip;
+	    top:=top^.nlink; level:=level-1
+	  end
+	else
+	  begin hip:=nil; lip:=nil; iflag:=[assigned];
+	    if sy=varsy then
+	      begin iflag:=[refer,assigned,used]; insym end;
+	    repeat pip:=newident(vars,nil,nil,+0102);
+	      if pip<>nil then
+		begin enterid(pip); pip^.iflag:=iflag;
+		  if lip=nil then hip:=pip else lip^.next:=pip; lip:=pip;
+		end;
+	      iflag:=iflag+[samesect];
+	    until endofloop(fsys+[semicolon,colon1],[ident],comma,+0103);
+	    {+0104}
+	    nextif(colon1,+0105);
+	    if refer in iflag then
+	      begin lsp:=vpartyp(fsys+[semicolon]); tsp:=lsp;
+		while formof(tsp,[carray]) do
+		  begin tsp^.arpos.ad:=posaddr(maxlb,nilptr,false);
+		    tsp:=tsp^.aeltype
+		  end;
+		tsp:=nilptr;
+	      end
+	    else
+	      begin lsp:=typid(+0106); tsp:=lsp end;
+	    pip:=hip;
+	    while pip<>nil do
+	      begin pip^.vpos.ad:=posaddr(maxlb,tsp,false); pip^.idtype:=lsp;
+		pip:=pip^.next
+	      end;
+	  end;
+	if lastip=nil then tip:=hip else lastip^.next:=hip; lastip:=lip;
+      end;
+  until endofloop(fsys,[ident,varsy,procsy,funcsy],semicolon,+0107);  {+0108}
+end;
+
+procedure pfhead;  {forward declared}
+var lip:ip; lsp:sp; lnp:np; kl:idclass;
+begin lip:=nil; again:=false;
+  if sy=procsy then kl:=proc else
+    begin kl:=func; fsys:=fsys+[colon1,ident] end;
+  insym;
+  if sy<>ident then begin error(+0109); id:=spaces end;
+  if not param then lip:=searchsection(top^.fname);
+  if lip<>nil then
+    if (lip^.klass<>kl) or (lip^.pfkind<>forward) then errid(+0110,id) else
+      begin b.forwcount:=b.forwcount-1; again:=true end;
+  if again then insym else
+    begin lip:=newip(kl,id,nil,nil);
+      if sy=ident then begin enterid(lip); insym end;
+      lastpfno:=lastpfno+1; lip^.pfno:=lastpfno;
+    end;
+  level:=level+1;
+  new(lnp,blck); lnp^.occur:=blck; lnp^.nlink:=top; top:=lnp;
+  if again then lnp^.fname:=lip^.parhead else
+    begin lnp^.fname:=nil;
+      if find3(lparent,fsys,+0111) then
+	begin parlist(fsys+[rparent],lip^.pfpos.lv>1,lip^.parhead,lip^.maxlb);
+	  nextif(rparent,+0112)
+	end;
+    end;
+  if (kl=func) and not again then
+    begin nextif(colon1,+0113); lsp:=typid(+0114);
+      if formof(lsp,[power..tag]) then
+	begin error(+0115); lsp:=nil end;
+      lip^.idtype:=lsp;
+    end;
+  fip:=lip;
+end;
+
+procedure pfdeclaration(fsys:sos);
+var lip:ip; again,headonly:boolean; markp:^integer; lbp:bp; kind:kindofpf;
+begin with b do begin
+  pfhead(fsys+[ident,semicolon,labelsy..beginsy],lip,again,false);
+  nextif(semicolon,+0116);
+  if find1([ident,labelsy..beginsy],fsys+[semicolon],+0117) then
+    begin headonly:=sy=ident;
+      if headonly then
+	begin kind:=standard;
+	  if id='forward ' then kind:=forward else
+	  if id='extern  ' then kind:=extern  else
+	  if id='varargs ' then kind:=varargs else errid(+0118,id);
+	  if kind<>standard then
+	    begin insym; lip^.pfkind:=kind;
+	      if kind=forward then
+		if again then errid(+0119,lip^.name) else
+		  forwcount:=forwcount+1
+	      else
+		begin lip^.pfpos.lv:=1; teststandard end
+	    end;
+	end;
+      if not again then
+	if lip^.pfpos.lv<=1 then genpnam(ps_exp,lip) else genpnam(ps_inp,lip);
+      if not headonly then
+	begin lip^.pfkind:=actual;
+#ifndef STANDARD
+	  mark(markp);
+#endif
+	  new(lbp); lbp^:=b; nextbp:=lbp;
+	  reglb:=0; minlb:=0; ilbno:=0; forwcount:=0; lchain:=nil;
+	  block(fsys+[semicolon],lip);
+	  b:=nextbp^;
+#ifndef STANDARD
+	  release(markp);
+#endif
+	end;
+    end;
+  if not main then eofexpected:=forwcount=0;
+  nextif(semicolon,+0120);
+  level:=level-1; top:=top^.nlink;
+end end;
+
+{===================================================================}
+
+procedure expression(fsys:sos); forward;
+	{this forward declaration cannot be avoided}
+
+procedure selectarrayelement(fsys:sos);
+var isp,lsp:sp;
+begin
+  repeat loadaddr; isp:=nil;
+    if formof(a.asp,[arrays,carray]) then isp:=a.asp^.inxtype else
+      errasp(+0121);
+    lsp:=a.asp;
+    expression(fsys+[comma]); force(desub(isp),+0122);
+		{no range check}
+    if lsp<>nil then
+      begin a.packbit:=spack in lsp^.sflag;
+	descraddr(lsp^.arpos); lsp:=lsp^.aeltype
+      end;
+    a.asp:=lsp; a.ak:=indexed;
+  until endofloop(fsys,[notsy..lparent],comma,+0123);  {+0124}
+end;
+
+procedure selector(fsys: sos; fip:ip; iflag:iflagset);
+{selector computes the address of any kind of variable.
+  Four possibilities:
+  1.for direct accessable variables (fixed), a contains offset and level,
+  2.for indirect accessable variables (ploaded), the address is on the stack.
+  3.for array elements, the top of stack gives the index (one word).
+    The address of the array is beneath it.
+  4.for variables with address in direct accessible pointer variable (pfixed),
+    the offset and level of the pointer is stored in a.
+  If a.asp=nil then an error occurred else a.asp gives
+  the type of the variable.
+}
+var lip:ip;
+begin inita(fip^.idtype,0);
+  case fip^.klass of
+    vars: with a do
+      begin pos:=fip^.vpos; if refer in fip^.iflag then ak:=pfixed end;
+    field:
+      begin a:=lastnp^.wa; fieldaddr(fip^.foffset); a.asp:=fip^.idtype end;
+    func: with a do
+      if fip^.pfkind=standard then errasp(+0125) else
+      if (fip^.pfpos.lv>=level-1) and (fip<>currproc) then error(+0126) else
+      if fip^.pfkind<>actual then error(+0127) else
+	begin pos:=fip^.pfpos; pos.lv:=pos.lv+1;
+	  if sy=arrow then error(+0128);
+	end
+  end;  {case}
+  if (sy=lbrack) or (sy=period) then iflag:=iflag+[noreg];
+  while find2([lbrack,period,arrow],fsys,+0129) do with a do
+    if sy=lbrack then
+      begin insym; selectarrayelement(fsys+[rbrack,lbrack,period,arrow]);
+	nextif(rbrack,+0130);
+      end else
+    if sy=period then
+      begin insym;
+	if sy<>ident then error(+0131) else
+	  begin
+	    if not formof(asp,[records]) then errasp(+0132) else
+	      begin lip:=searchsection(asp^.fstfld);
+		if lip=nil then begin errid(+0133,id); asp:=nil end else
+		  begin packbit:=spack in asp^.sflag;
+		    fieldaddr(lip^.foffset); asp:=lip^.idtype
+		  end
+	      end;
+	    insym
+	  end
+      end
+    else
+      begin insym; iflag:=[used];
+	if asp<>nil then
+	  if asp=zeroptr then errasp(+0134) else
+	  if asp^.form=pointer then
+	    begin
+	      if ak=fixed then ak:=pfixed else
+		begin load; ak:=ploaded end;
+	      asp:=asp^.eltype
+	    end else
+	  if asp^.form=files then
+	    begin loadaddr; gensp(WDW,sz_addr); gencst(op_lfr,sz_addr);
+	      asp:=asp^.filtype; ak:=ploaded; packbit:=true;
+	    end
+	  else errasp(+0135);
+      end;
+  fip^.iflag:=fip^.iflag+iflag;
+end;
+
+procedure variable(fsys:sos);
+var lip: ip;
+begin
+  if sy=ident then
+    begin lip:=searchid([vars,field]); insym;
+      selector(fsys,lip,[used,assigned,noreg])
+    end
+  else begin error(+0136); inita(nil,0) end;
+end;
+
+{===================================================================}
+
+function plistequal(p1,p2:ip):boolean;
+var ok:boolean; q1,q2:sp;
+begin plistequal:=eqstruct(p1^.idtype,p2^.idtype);
+  p1:=p1^.parhead; p2:=p2^.parhead;
+  while (p1<>nil) and (p2<>nil) do
+    begin ok:=false;
+      if p1^.klass=p2^.klass then
+	if p1^.klass<>vars then ok:=plistequal(p1,p2) else
+	  begin q1:=p1^.idtype; q2:=p2^.idtype; ok:=true;
+	    while ok and formof(q1,[carray]) and formof(q2,[carray]) do
+	      begin ok:=eqstruct(q1^.inxtype,q2^.inxtype);
+		q1:=q1^.aeltype; q2:=q2^.aeltype;
+	      end;
+	    if not (eqstruct(q1,q2) and
+		    (p1^.iflag*[refer,samesect] = p2^.iflag*[refer,samesect]))
+	      then ok:=false;
+	  end;
+      if not ok then plistequal:=false;
+      p1:=p1^.next; p2:=p2^.next
+    end;
+  if (p1<>nil) or (p2<>nil) then plistequal:=false
+end;
+
+procedure callnonstandard(fsys:sos; moreargs:boolean; fip:ip);
+var nxt,lip:ip; l0,l1,l2,l3,sz:integer; lsp,savasp:sp;
+begin with a do begin
+  l0:=lino; sz:=0; nxt:=fip^.parhead;
+  while moreargs do
+    begin l1:=lino;
+      if nxt=nil then
+	begin if fip^.pfkind<>varargs then error(+0137);
+	  expression(fsys); load; sz:=sz+sizeof(asp,wordmult)
+	end
+      else
+	begin lsp:=nxt^.idtype;
+	  if nxt^.klass<>vars then  {proc or func}
+	    begin inita(procptr,0); sz:=sz+sz_proc;
+	      if sy<>ident then error(+0138) else
+		begin lip:=searchid([nxt^.klass]); insym;
+		  if lip^.pfkind=standard then error(+0139) else
+		  if not plistequal(nxt,lip) then error(+0140)
+		  else
+		    begin pos:=lip^.pfpos;
+		      if lip^.pfkind=formal then load else
+			begin
+			  if lip^.pfpos.lv<=1 then gencst(op_zer,sz_addr) else
+			    gencst(op_lxl,level-lip^.pfpos.lv);
+			  genpnam(op_lpi,lip)
+			end
+		    end
+		end
+	    end
+	  else if not (refer in nxt^.iflag) then  {call by value}
+	    begin expression(fsys); force(lsp,+0141);
+	      sz:=sz+sizeof(asp,wordmult);
+	    end
+	  else  {call by reference}
+	    begin variable(fsys); loadaddr; sz:=sz+sz_addr;
+	      if samesect in nxt^.iflag then lsp:=savasp else
+		begin savasp:=asp; l2:=lino;
+		  while formof(lsp,[carray])
+			and formof(asp,[arrays,carray]) do
+		    if (compat(lsp^.inxtype,asp^.inxtype) > subeq) or
+			  (lsp^.sflag<>asp^.sflag) then errasp(+0142) else
+		      begin l3:=lino; descraddr(asp^.arpos); exchange(l2,l3);
+			sz:=sz+sz_addr; asp:=asp^.aeltype; lsp:=lsp^.aeltype
+		      end
+		end;
+	      if not eqstruct(asp,lsp) then errasp(+0143);
+	      if packbit then errasp(+0144);
+	    end;
+	  nxt:=nxt^.next
+	end;
+      exchange(l0,l1); moreargs:=find3(comma,fsys,+0145)
+    end;
+  if nxt<>nil then error(+0146);
+  inita(procptr,0); pos:=fip^.pfpos;
+  if fip^.pfkind=formal then
+    with b do
+      begin load; ilbno:=ilbno+2;
+	gencst(op_exg,sz_addr);
+	gencst(op_dup,sz_addr);
+	gencst(op_zer,sz_addr);
+	genop(op_cmp);
+	gencst(op_zeq,ilbno-1);
+	gencst(op_exg,sz_addr);
+	genop(op_cai);
+	gencst(op_asp,sz_addr);
+	gencst(op_bra,ilbno);
+	newilb(ilbno-1);
+	gencst(op_asp,sz_addr);
+	genop(op_cai);
+	newilb(ilbno);
+      end
+  else
+    begin
+      if pos.lv>1 then
+	begin gencst(op_lxl,level-pos.lv); sz:=sz+sz_addr end;
+      genpnam(op_cal,fip)
+    end;
+  if sz<>0 then gencst(op_asp,sz);
+  asp:=fip^.idtype;
+  if asp<>nil then genasp(op_lfr)
+end end;
+
+procedure fileaddr;
+var la:attr;
+begin la:=a; a:=fa; loadaddr; a:=la end;
+
+procedure callr(l1,l2:integer);
+var la:attr; m:libmnem;
+begin with a do begin
+  la:=a; asp:=desub(asp); fileaddr; m:=RDI;
+  if asp<>intptr then
+  if asp=charptr then m:=RDC else
+  if asp=realptr then m:=RDR else
+  if asp=longptr then m:=RDL else errasp(+0147);
+  gensp(m,sz_addr); genasp(op_lfr);
+  if asp<>la.asp then checkbnds(la.asp);
+  a:=la; exchange(l1,l2); store;
+end end;
+
+procedure callw(fsys:sos; l1,l2:integer);
+var m:libmnem; s:integer;
+begin with a do begin
+  fileaddr; exchange(l1,l2); loadcheap; asp:=desub(asp);
+  if string(asp) then
+    begin gencst(op_loc,asp^.size); m:=WRS; s:=sz_addr+sz_word end
+  else
+    begin m:=WRI; s:=sizeof(asp,wordmult);
+      if asp<>intptr then
+      if asp=charptr then m:=WRC else
+      if asp=realptr then m:=WRR else
+      if asp=boolptr then m:=WRB else
+      if asp=zeroptr then m:=WRZ else
+      if asp=longptr then m:=WRL else errasp(+0148);
+    end;
+  if find3(colon1,fsys,+0149) then
+    begin expression(fsys+[colon1]); force(intptr,+0150);
+      m:=succ(m); s:=s+sz_int
+    end;
+  if find3(colon1,fsys,+0151) then
+    begin expression(fsys); force(intptr,+0152); s:=s+sz_int;
+      if m<>WSR then error(+0153) else m:=WRF;
+    end;
+  gensp(m,s+sz_addr);
+end end;
+
+procedure callrw(fsys:sos; lpar,w,ln:boolean);
+var l1,l2,errno:integer; ftype,lsp,fsp:sp; savlb:integer; m:libmnem;
+begin with b do begin savlb:=reglb; ftype:=textptr;
+  inita(textptr,argv[ord(w)].ad); a.pos.lv:=0; fa:=a;
+  if lpar then
+    begin l1:=lino; if w then expression(fsys+[colon1]) else variable(fsys);
+      l2:=lino;
+      if formof(a.asp,[files]) then
+	begin ftype:=a.asp;
+	  if (a.ak<>fixed) and (a.ak<>pfixed) then
+	    begin loadaddr; temporary(nilptr,reg_pointer);
+	      store; a.ak:=pfixed
+	    end;
+	  fa:=a;  {store doesn't change a}
+	  if (sy<>comma) and not ln then error(+0154);
+	end
+      else
+	begin if iop[w]=nil then error(+0155);
+	  if w then callw(fsys,l1,l2) else callr(l1,l2)
+	end;
+      while find3(comma,fsys,+0156) do with a do
+	begin l1:=lino;
+	  if w then expression(fsys+[colon1]) else variable(fsys);
+	  l2:=lino;
+	  if ftype=textptr then
+	    if w then callw(fsys,l1,l2) else callr(l1,l2)
+	  else
+	    begin errno:=+0157; fsp:=ftype^.filtype;
+	      if w then force(fsp,errno) else
+		begin store; lsp:=asp; l2:=lino end;
+	      fileaddr; gensp(WDW,sz_addr); gencst(op_lfr,sz_addr);
+	      ak:=ploaded; packbit:=true; asp:=fsp;
+	      if w then store else
+		begin force(lsp,errno); exchange(l1,l2) end;
+	      fileaddr; if w then m:=PUTX else m:=GETX; gensp(m,sz_addr)
+	    end
+	end;
+    end
+  else
+    if not ln then error(+0158) else
+      if iop[w]=nil then error(+0159);
+  if ln then
+    begin if ftype<>textptr then error(+0160);
+      fileaddr; if w then m:=WLN else m:=RLN; gensp(m,sz_addr)
+    end;
+  reglb:=savlb
+end end;
+
+procedure callnd(fsys:sos);
+label 1;
+var lsp:sp; int:integer;
+begin with a do begin
+  if asp=zeroptr then errasp(+0161) else asp:=asp^.eltype;
+  while find3(comma,fsys,+0162) do
+    begin
+      if asp<>nil then  {asp of form record or variant}
+	if asp^.form=records then asp:=asp^.tagsp else
+	if asp^.form=variant then asp:=asp^.subtsp else errasp(+0163);
+      if asp=nil then constant(fsys,lsp,int) else
+	begin assert asp^.form=tag;
+	  int:=cstinteger(fsys,asp^.tfldsp,+0164); lsp:=asp^.fstvar;
+	  while lsp<>nil do
+	    if lsp^.varval<>int then lsp:=lsp^.nxtvar else
+	      begin asp:=lsp; goto 1 end;
+	end;
+1:  end;
+  genasp(op_loc)
+end end;
+
+procedure call(fsys: sos; fip: ip);
+var lkey: standpf; lpar:boolean; lsp,sp1,sp2:sp;
+    m:libmnem; s:integer; b:byte;
+begin with a do begin fsys:=fsys+[comma];
+  lpar:=find3(lparent,fsys,+0165); if lpar then fsys:=fsys+[rparent];
+  if fip^.pfkind<>standard then callnonstandard(fsys,lpar,fip) else
+    begin lkey:=fip^.key; m:=CLS; lsp:=nil;
+      if not lpar then
+	if lkey in [pput..prelease,fabs..fatn] then error(+0166);
+      if lkey in [pput..ppage,feof,feoln] then
+	begin s:=sz_addr;
+	  if lpar then
+	    begin variable(fsys); loadaddr end
+	  else
+	    begin asp:=textptr;
+	      if iop[lkey=ppage]=nil then errasp(+0167) else
+		gencst(op_lae,argv[ord(lkey=ppage)].ad)
+	    end;
+	  if lkey in [pput..prewrite,ppage,feof,feoln] then
+	    if not formof(asp,[files]) then
+	      begin error(+0168); asp:=textptr end;
+	  if lkey in [pnew,pdispose,pmark,prelease] then
+	    if not formof(asp,[pointer]) then
+	      begin error(+0169); asp:=nilptr end;
+	end;
+      case lkey of
+	pread, preadln, pwrite, pwriteln:       {0,1,2,3 resp}
+	  callrw(fsys,lpar,lkey>=pwrite,odd(ord(lkey)));
+	pput: m:=PUTX;
+	pget: m:=GETX;
+	ppage: m:=PAG;
+	preset: m:=OPN;
+	prewrite: m:=CRE;
+	pnew: m:=NEWX;
+	pdispose: m:=DIS;
+	ppack:
+	  begin sp2:=asp; nextif(comma,+0170); expression(fsys); load;
+	    lsp:=asp; nextif(comma,+0171); variable(fsys); loadaddr;
+	    sp1:=asp; asp:=lsp; m:=PAC
+	  end;
+	punpack:
+	  begin sp1:=asp; nextif(comma,+0172); variable(fsys); loadaddr;
+	    sp2:=asp; nextif(comma,+0173); expression(fsys); load;
+	    m:=UNP
+	  end;
+	pmark: m:=SAV;
+	prelease: m:=RST;
+	phalt:
+	  begin m:=HLT; teststandard;
+	    if lpar then lsp:=intptr else gencst(op_loc,0);
+	  end;
+	feof: m:=EFL;
+	feoln: m:=ELN;
+	fodd, fchr: lsp:=intptr;
+	fpred: b:=op_dec;
+	fsucc: b:=op_inc;
+	fround: m:=RND;
+	fsin, fcos, fexp, fsqt, flog, fatn: lsp:=realptr;
+	fabs, fsqr, ford, ftrunc: ;
+      end;
+      if lpar then if lkey in [phalt,fabs..fatn] then
+	begin expression(fsys);
+	  force(lsp,+0174); s:=sizeof(asp,wordmult)
+	end;
+      if lkey in [ppack,punpack,fabs..fodd] then
+	asp:=desub(asp);
+      case lkey of
+	ppage, feoln:
+	  begin if asp<>textptr then error(+0175); asp:=boolptr end;
+	preset, prewrite:
+	  begin s:=sz_addr+sz_word;
+	    if asp=textptr then gencst(op_loc,0) else
+	      gencst(op_loc,sizeof(asp^.filtype,wordpart));
+	  end;
+	pnew, pdispose:
+	  begin callnd(fsys); s:=sz_addr+sz_word end;
+	ppack, punpack:
+	  begin s:=2*sz_addr+sz_int;
+	    if formof(sp1,[arrays,carray])
+	       and formof(sp2,[arrays,carray]) then
+	      if (spack in (sp1^.sflag - sp2^.sflag)) and
+		  eqstruct(sp1^.aeltype,sp2^.aeltype) and
+		  eqstruct(desub(sp1^.inxtype),asp) and
+		  eqstruct(desub(sp2^.inxtype),asp) then
+		begin descraddr(sp1^.arpos); descraddr(sp2^.arpos) end
+	      else error(+0176)
+	    else error(+0177)
+	  end;
+	pmark, prelease: teststandard;
+	feof: asp:=boolptr;
+	fabs:
+	  if asp=intptr then m:=ABI else
+	  if asp=longptr then m:=ABL else
+	  if asp=realptr then m:=ABR else errasp(+0178);
+	fsqr:
+	  begin
+	    if (asp=intptr) or (asp=longptr) then b:=op_mli else
+	    if asp=realptr then begin b:=op_mlf; fltused:=true end
+	    else errasp(+0179);
+	    genasp(op_dup); genasp(b)
+	  end;
+	ford:
+	  begin if not nicescalar(asp) then errasp(+0180); asp:=intptr end;
+	fchr: checkbnds(charptr);
+	fpred, fsucc:
+	  begin genop(b);
+	    if nicescalar(asp) then genrck(asp) else errasp(+0181)
+	  end;
+	fodd:
+	  begin gencst(op_loc,1); asp:=boolptr; genasp(op_and) end;
+	ftrunc, fround: if asp<>realptr then errasp(+0182);
+	fsin: m:=SINX;
+	fcos: m:=COSX;
+	fexp: m:=EXPX;
+	fsqt: m:=SQT;
+	flog: m:=LOG;
+	fatn: m:=ATN;
+	phalt:s:=0;
+	pread, preadln, pwrite, pwriteln, pput, pget: ;
+      end;
+      if m<>CLS then
+	begin gensp(m,s);
+	  if lkey>=feof then genasp(op_lfr)
+	end;
+      if (lkey=fround) or (lkey=ftrunc) then
+	opconvert(ri);
+    end;
+  if lpar then nextif(rparent,+0183);
+end end;
+
+{===================================================================}
+
+procedure convert(fsp:sp; l1:integer);
+{Convert tries to make the operands of some operator of the same type.
+  The operand types are given by fsp and a.asp. The resulting type
+  is put in a.asp.
+  l1 gives the lino of the first instruction of the right operand.
+}
+var l2:integer; ts:twostruct; lsp:sp;
+begin with a do begin asp:=desub(asp);
+  ts:=compat(asp,fsp);
+  case ts of
+    eq,subeq:
+      ;
+    il,ir,lr:
+      opconvert(ts);
+    es:
+      expandnullset(fsp);
+    li,ri,rl,se:
+      begin l2:=lino; lsp:=asp; asp:=fsp;
+	convert(lsp,l1); exchange(l1,l2); asp:=lsp
+      end;
+    noteq:
+      errasp(+0184);
+  end;
+  if asp=realptr then fltused:=true
+end end;
+
+procedure buildset(fsys:sos);
+{This is a bad construct in pascal. Two objections:
+  - expr..expr very difficult to implement on most machines
+  - this construct makes it hard to implement sets of different size
+}
+const   ncsw    = 16;   {tunable}
+type    wordset = set of 0..MB2;
+var     i,j,val1,val2,ncst,l1,l2,sz:integer;
+	cst1,cst2,cst12,varpart:boolean;
+	cstpart:array[1..ncsw] of wordset;
+
+procedure genwordset(s:wordset);
+	{level 2: <<  buildset}
+var b,i,w:integer;
+begin i:=0; w:=0; b:=-1;
+  repeat
+    if i in s then w:=w-b; b:=b+b; i:=i+1
+  until i=MB2;
+  if i in s then w:=w+b;
+  gencst(op_loc,w)
+end;
+
+procedure setexpr(fsys:sos; var c:boolean; var v:integer);
+	{level 2: <<  buildset}
+var min:integer; lsp:sp;
+begin with a do begin c:=false; v:=0; lsp:=asp;
+  expression(fsys); asp:=desub(asp);
+  if not eqstruct(asp,lsp^.elset) then
+    begin error(+0185); lsp:=nullset end;
+  if lsp=nullset then
+    begin
+      if bounded(asp) then bounds(asp,min,sz) else
+	if asp=intptr then sz:=iopt-1 else begin errasp(+0186); sz:=0 end;
+      sz:=sz div NB1 + 1; while sz mod sz_word <> 0 do sz:=sz+1;
+      if sz>sz_mset then errasp(+0187);
+      lsp:=newsp(power,sz); lsp^.elset:=asp
+    end;
+  if asp<>nil then if ak=cst then
+    if (pos.ad<0) or (pos.ad div NB1>=sizeof(lsp,wordmult)) then
+      error(+0188)
+    else if sz<=ncsw*sz_word then
+      begin c:=true; v:=pos.ad end;
+  if not c then load; asp:=lsp
+end end;
+
+begin with a do begin  {buildset}
+  varpart:=false; ncst:=0; asp:=nullset;
+  for i:=1 to ncsw do cstpart[i]:=[];
+  if find2([notsy..lparent],fsys,+0189) then
+    repeat l1:=lino;
+      setexpr(fsys+[colon2,comma],cst1,val1); cst12:=cst1;
+      if find3(colon2,fsys+[comma,notsy..lparent],+0190) then
+	begin setexpr(fsys+[comma,notsy..lparent],cst2,val2);
+	  cst12:=cst12 and cst2;
+	  if not cst12 then
+	    begin
+	      if cst2 then gencst(op_loc,val2);
+	      if cst1 then
+		begin l2:=lino; gencst(op_loc,val1); exchange(l1,l2) end;
+	      l2:=lino; genasp(op_zer); exchange(l1,l2);
+	      genasp(op_loc); gensp(BTS,3*sz_word)
+	    end;
+	end
+      else
+	if cst12 then val2:=val1 else genasp(op_set);
+      if cst12 then
+	for i:=val1 to val2 do
+	  begin j:=i div NB2 + 1; ncst:=ncst+1;
+	    cstpart[j]:=cstpart[j] + [i mod NB2]
+	  end
+      else
+	if varpart then genasp(op_ior) else varpart:=true;
+    until endofloop(fsys,[notsy..lparent],comma,+0191);  {+0192}
+  ak:=loaded;
+  if ncst>0 then
+    begin
+      for i:=sizeof(asp,wordmult) div sz_word downto 1 do
+	genwordset(cstpart[i]);
+      if varpart then genasp(op_ior);
+    end
+  else
+    if not varpart then genasp(op_zer);  {empty set}
+end end;
+
+procedure factor(fsys: sos);
+var lip:ip; lsp:sp;
+begin with a do begin
+  asp:=nil; packbit:=false; ak:=loaded;
+  if find1([notsy..nilcst,lparent],fsys,+0193) then
+    case sy of
+      ident:
+	begin lip:=searchid([konst,vars,field,func,carrbnd]); insym;
+	  case lip^.klass of
+	    func: {call moves result to top stack}
+	      begin call(fsys,lip); ak:=loaded; packbit:=false end;
+	    konst:
+	      begin asp:=lip^.idtype;
+		if nicescalar(asp) then  {including asp=nil}
+		  begin ak:=cst; pos.ad:=lip^.value end
+		else
+		  begin ak:=ploaded; laedlb(abs(lip^.value));
+		    if asp^.form=scalar then
+		      begin load; if lip^.value<0 then negate end
+		    else
+		      if asp=zeroptr then ak:=loaded
+		  end
+	      end;
+	    field,vars:
+	      selector(fsys,lip,[used]);
+	    carrbnd:
+	      begin lsp:=lip^.idtype; assert formof(lsp,[carray]);
+		descraddr(lsp^.arpos); lsp:=lsp^.inxtype; asp:=desub(lsp);
+		if lip^.next=nil then ak:=ploaded {low bound} else
+		  begin gencst(op_loi,2*sz_int); genasp(op_adi) end;
+		load; checkbnds(lsp);
+	      end;
+	  end  {case}
+	end;
+      intcst:
+	begin asp:=intptr; ak:=cst; pos.ad:=val; insym end;
+      realcst:
+	begin asp:=realptr; ak:=ploaded; laedlb(val); insym end;
+      longcst:
+	begin asp:=longptr; ak:=ploaded; laedlb(val); insym end;
+      charcst:
+	begin asp:=charptr; ak:=cst; pos.ad:=val; insym end;
+      stringcst:
+	begin asp:=stringstruct; laedlb(val); insym;
+	  if asp<>zeroptr then ak:=ploaded;
+	end;
+      nilcst:
+	begin insym; asp:=nilptr; genasp(op_zer); end;
+      lparent:
+	begin insym; expression(fsys+[rparent]); nextif(rparent,+0194) end;
+      notsy:
+	begin insym; factor(fsys); load; genop(op_teq); asp:=desub(asp);
+	  if asp<>boolptr then errasp(+0195)
+	end;
+      lbrack:
+	begin insym; buildset(fsys+[rbrack]); nextif(rbrack,+0196) end;
+    end
+end end;
+
+procedure term(fsys:sos);
+var lsy:symbol; lsp:sp; l1:integer; first:boolean;
+begin with a,b do begin first:=true; l1:=lino;
+  factor(fsys+[starsy..andsy]);
+  while find2([starsy..andsy],fsys,+0197) do
+    begin if first then begin load; first:=false end;
+      lsy:=sy; insym; l1:=lino; lsp:=asp;
+      factor(fsys+[starsy..andsy]); load; convert(lsp,l1);
+      if asp<>nil then
+	case lsy of
+	  starsy:
+	    if (asp=intptr) or (asp=longptr) then genasp(op_mli) else
+	    if asp=realptr then genasp(op_mlf) else
+	    if asp^.form=power then genasp(op_and) else errasp(+0198);
+	  slashsy:
+	    begin
+	      if (asp=intptr) or (asp=longptr) then
+		begin lsp:=asp;
+		  convert(realptr,l1);  {make real of right operand}
+		  convert(lsp,l1);  {make real of left operand}
+		end;
+	      if asp=realptr then genasp(op_dvf) else errasp(+0199);
+	    end;
+	  divsy:
+	    if (asp=intptr) or (asp=longptr) then genasp(op_dvi) else
+	      errasp(+0200);
+	  modsy:
+	    begin
+	      if asp=intptr then gensp(MDI,2*sz_int) else
+	      if asp=longptr then gensp(MDL,2*sz_long) else errasp(+0201);
+	      genasp(op_lfr);
+	    end;
+	  andsy:
+	    if asp=boolptr then genasp(op_and) else errasp(+0202);
+	end {case}
+    end {while}
+end end;
+
+procedure simpleexpression(fsys:sos);
+var lsy:symbol; lsp:sp; l1:integer; signed,min,first:boolean;
+begin with a do begin l1:=lino; first:=true;
+  signed:=(sy=plussy) or (sy=minsy);
+  if signed then begin min:=sy=minsy; insym end else min:=false;
+  term(fsys + [minsy,plussy,orsy]); lsp:=desub(asp);
+  if signed then
+    if (lsp<>intptr) and (lsp<>realptr) and (lsp<>longptr) then
+      errasp(+0203)
+    else if min then
+      begin load; first:=false; asp:=lsp; negate end;
+  while find2([plussy,minsy,orsy],fsys,+0204) do
+    begin if first then begin load; first:=false end;
+      lsy:=sy; insym; l1:=lino; lsp:=asp;
+      term(fsys+[minsy,plussy,orsy]); load; convert(lsp,l1);
+      if asp<>nil then
+	case lsy of
+	  plussy:
+	    if (asp=intptr) or (asp=longptr) then genasp(op_adi) else
+	    if asp=realptr then genasp(op_adf) else
+	    if asp^.form=power then genasp(op_ior) else errasp(+0205);
+	  minsy:
+	    if (asp=intptr) or (asp=longptr) then genasp(op_sbi) else
+	    if asp=realptr then genasp(op_sbf) else
+	    if asp^.form=power then begin genasp(op_com); genasp(op_and) end
+	    else errasp(+0206);
+	  orsy:
+	    if asp=boolptr then genasp(op_ior) else errasp(+0207);
+	end {case}
+    end {while}
+end end;
+
+procedure expression; { fsys:sos }
+var lsy:symbol; lsp:sp; l1,l2:integer;
+begin with a do begin l1:=lino;
+  simpleexpression(fsys+[eqsy..insy]);
+  if find2([eqsy..insy],fsys,+0208) then
+    begin lsy:=sy; insym; lsp:=asp; loadcheap; l2:=lino;
+      simpleexpression(fsys); loadcheap;
+      if lsy=insy then
+	begin
+	  if not formof(asp,[power]) then errasp(+0209) else
+	    if asp=nullset then genasp(op_and) else
+		  {this effectively replaces the word on top of the
+		   stack by the result of the 'in' operator: false }
+	    if not (compat(lsp,asp^.elset) <= subeq) then errasp(+0210) else
+	      begin exchange(l1,l2); genasp(op_inn) end
+	end
+      else
+	begin convert(lsp,l2);
+	  if asp<>nil then
+	    case asp^.form of
+	      scalar:
+		if asp=realptr then genasp(op_cmf) else genasp(op_cmi);
+	      pointer:
+		if (lsy=eqsy) or (lsy=nesy) then genop(op_cmp) else
+		  errasp(+0211);
+	      power:
+		case lsy of
+		  eqsy,nesy: genasp(op_cms);
+		  ltsy,gtsy: errasp(+0212);
+		  lesy:  {'a<=b' equivalent to 'a-b=[]'}
+		    begin genasp(op_com); genasp(op_and); genasp(op_zer);
+		      genasp(op_cms); lsy:=eqsy
+		    end;
+		  gesy:  {'a>=b' equivalent to 'a=a+b'}
+		    begin gencst(op_dup,2*sizeof(asp,wordmult));
+		      genasp(op_asp); genasp(op_ior);
+		      genasp(op_cms); lsy:=eqsy
+		    end
+		end;  {case}
+	      arrays:
+		if string(asp) then
+		  begin gencst(op_loc,asp^.size);
+		    gensp(BCP,2*sz_addr+sz_word);
+		    gencst(op_lfr,sz_word)
+		  end
+		else errasp(+0213);
+	      records: errasp(+0214);
+	      files: errasp(+0215)
+	    end;  { case }
+	  case lsy of
+	    ltsy: genop(op_tlt);
+	    lesy: genop(op_tle);
+	    gtsy: genop(op_tgt);
+	    gesy: genop(op_tge);
+	    nesy: genop(op_tne);
+	    eqsy: genop(op_teq)
+	  end
+	end;
+      asp:=boolptr; ak:=loaded
+    end;
+end end;
+
+{===================================================================}
+
+procedure statement(fsys:sos); forward;
+		{this forward declaration can be avoided}
+
+procedure assignment(fsys:sos; fip:ip);
+var la:attr; l1,l2:integer;
+begin
+  l1:=lino; selector(fsys+[becomes],fip,[assigned]); l2:=lino;
+  la:=a; nextif(becomes,+0216);
+  expression(fsys); loadcheap; checkasp(la.asp,+0217);
+  exchange(l1,l2); a:=la;
+  if not formof(la.asp,[arrays..records]) then store else
+    begin loadaddr;
+      if la.asp^.form<>carray then genasp(op_blm) else
+	begin descraddr(la.asp^.arpos); gensp(ASZ,2*sz_addr);
+	  gencst(op_lfr,sz_word); gencst(op_bls,sz_word)
+	end;
+    end;
+end;
+
+procedure gotostatement;
+{jumps into structured statements can give strange results. }
+label 1;
+var llp:lp; lbp:bp; diff:integer;
+begin
+  if sy<>intcst then error(+0218) else
+    begin llp:=searchlab(b.lchain,val);
+      if llp<>nil then gencst(op_bra,llp^.labname) else
+	begin lbp:=b.nextbp; diff:=1;
+	  while lbp<>nil do
+	    begin llp:=searchlab(lbp^.lchain,val);
+	      if llp<>nil then goto 1;
+	      lbp:=lbp^.nextbp; diff:=diff+1;
+	    end;
+1:        if llp=nil then errint(+0219,val) else
+	    begin
+	      if llp^.labdlb=0 then
+		begin dlbno:=dlbno+1; llp^.labdlb:=dlbno;
+		  genop(ps_ina); argdlb(dlbno);  {forward data reference}
+		end;
+	      laedlb(llp^.labdlb);
+	      if diff=level-1 then gencst(op_zer,sz_addr) else
+		gencst(op_lxl,diff);
+	      gensp(GTO,2*sz_addr);
+	    end;
+	end;
+      insym;
+    end
+end;
+
+procedure compoundstatement(fsys:sos; err:integer);
+begin
+  repeat statement(fsys+[semicolon])
+  until endofloop(fsys,[beginsy..casesy],semicolon,err)
+end;
+
+procedure ifstatement(fsys:sos);
+var lb1,lb2:integer;
+begin with b do begin
+  expression(fsys+[thensy,elsesy]);
+  force(boolptr,+0220); ilbno:=ilbno+1; lb1:=ilbno; gencst(op_zeq,lb1);
+  nextif(thensy,+0221); statement(fsys+[elsesy]);
+  if find3(elsesy,fsys,+0222) then
+    begin ilbno:=ilbno+1; lb2:=ilbno; gencst(op_bra,lb2);
+      newilb(lb1); statement(fsys); newilb(lb2)
+    end
+  else newilb(lb1);
+end end;
+
+procedure casestatement(fsys:sos);
+label 1;
+type cip=^caseinfo;
+     caseinfo=record
+	next: cip;
+	csstart: integer;
+	cslab: integer
+     end;
+var lsp:sp; head,p,q,r:cip; l0,l1:integer;
+    ilb1,ilb2,dlb,i,n,m,min,max:integer;
+begin with b do begin
+  expression(fsys+[ofsy,semicolon,ident..plussy]); lsp:=a.asp; load;
+  if not nicescalar(desub(lsp)) then begin error(+0223); lsp:=nil end;
+  l0:=lino; ilbno:=ilbno+1; ilb1:=ilbno;
+  nextif(ofsy,+0224); head:=nil; max:=-MI2; min:=MI2; n:=0;
+  repeat ilbno:=ilbno+1; ilb2:=ilbno;   {label of current case}
+    repeat i:=cstinteger(fsys+[comma,colon1,semicolon],lsp,+0225);
+      if i>max then max:=i; if i<min then min:=i; n:=n+1;
+      q:=head; r:=nil; new(p);
+      while q<>nil do
+	begin  {chain all cases in ascending order}
+	  if q^.cslab>=i then
+	    begin if q^.cslab=i then error(+0226); goto 1 end;
+	  r:=q; q:=q^.next
+	end;
+1:    p^.next:=q; p^.cslab:=i; p^.csstart:=ilb2;
+      if r=nil then head:=p else r^.next:=p;
+    until endofloop(fsys+[colon1,semicolon],[ident..plussy],comma,+0227);
+    {+0228}
+    nextif(colon1,+0229); newilb(ilb2); statement(fsys+[semicolon]);
+    gencst(op_bra,ilb1);
+  until lastsemicolon(fsys,[ident..plussy],+0230);  {+0231 +0232}
+  assert n<>0; newilb(ilb1); l1:=lino;
+  dlb:=newdlb; genop(ps_rom); argnil;
+  if (max div 3) - (min div 3) < n then
+    begin argcst(min); argcst(max-min);
+      m:=op_csa;
+      while head<>nil do
+	begin
+	  while head^.cslab>min do
+	    begin argnil; min:=min+1 end;
+	  argilb(head^.csstart); min:=min+1; head:=head^.next
+	end;
+    end
+  else
+    begin argcst(n); m:=op_csb;
+      while head<>nil do
+	begin argcst(head^.cslab);argilb(head^.csstart);head:=head^.next end;
+    end;
+  argend; laedlb(dlb); gencst(m,sz_word); exchange(l0,l1)
+end end;
+
+procedure repeatstatement(fsys:sos);
+var lb1: integer;
+begin with b do begin
+  ilbno:=ilbno+1; lb1:=ilbno; newilb(lb1);
+  compoundstatement(fsys+[untilsy],+0233);  {+0234}
+  nextif(untilsy,+0235); genlin;
+  expression(fsys); force(boolptr,+0236); gencst(op_zeq,lb1);
+end end;
+
+procedure whilestatement(fsys:sos);
+var lb1,lb2: integer;
+begin with b do begin
+  ilbno:=ilbno+1; lb1:=ilbno; newilb(lb1);
+  ilbno:=ilbno+1; lb2:=ilbno;
+  genlin; expression(fsys+[dosy]);
+  force(boolptr,+0237); gencst(op_zeq,lb2);
+  nextif(dosy,+0238); statement(fsys);
+  gencst(op_bra,lb1); newilb(lb2)
+end end;
+
+procedure forstatement(fsys:sos);
+var lip:ip; tosym:boolean; endlab,looplab,savlb:integer;
+    av,at1,at2:attr; lsp:sp;
+
+procedure forbound(fsys:sos; var fa:attr; fsp:sp);
+begin
+  expression(fsys); fa:=a; force(fsp,+0239);
+  if fa.ak<>cst then
+    begin temporary(fsp,reg_any);
+      genasp(op_dup); fa:=a; store
+    end
+end;
+
+begin with b do begin savlb:=reglb; tosym:=false;
+  ilbno:=ilbno+1; looplab:=ilbno; ilbno:=ilbno+1; endlab:=ilbno;
+  inita(nil,0);
+  if sy<>ident then error(+0240) else
+    begin lip:=searchid([vars]); insym;
+      a.asp:=lip^.idtype; a.pos:=lip^.vpos;
+      lip^.iflag:=lip^.iflag+[used,assigned,loopvar];
+      if level>1 then
+	if (a.pos.ad>=0) or (a.pos.lv<>level) then
+	  error(+0241);
+    end;
+  lsp:=desub(a.asp);
+  if not nicescalar(lsp) then begin errasp(+0242); lsp:=nil end;
+  av:=a; nextif(becomes,+0243);
+  forbound(fsys+[tosy,downtosy,notsy..lparent,dosy],at1,lsp);
+  if find1([tosy,downtosy],fsys+[notsy..lparent,dosy],+0244) then
+    begin tosym:=sy=tosy; insym end;
+  forbound(fsys+[dosy],at2,lsp);
+  if tosym then gencst(op_bgt,endlab) else gencst(op_blt,endlab);
+  a:=at1; force(av.asp,+0245); a:=av; store; newilb(looplab);
+  nextif(dosy,+0246); statement(fsys);
+  a:=av; load; a:=at2; load; gencst(op_beq,endlab);
+  a:=av; load; if tosym then genop(op_inc) else genop(op_dec);
+  a.asp:=lsp; checkbnds(av.asp); a:=av; store;
+  gencst(op_bra,looplab); newilb(endlab);
+  reglb:=savlb
+end end;
+
+procedure withstatement(fsys:sos);
+var lnp,savtop:np; savlb:integer; pbit:boolean;
+begin with b do begin
+  savlb:=reglb; savtop:=top;
+  repeat variable(fsys+[comma,dosy]);
+    if not formof(a.asp,[records]) then errasp(+0247) else
+      begin pbit:=spack in a.asp^.sflag;
+	new(lnp,wrec); lnp^.occur:=wrec; lnp^.fname:=a.asp^.fstfld;
+	if a.ak<>fixed then
+	  begin loadaddr; temporary(nilptr,reg_pointer); store;
+	    a.ak:=pfixed;
+	  end;
+	a.packbit:=pbit; lnp^.wa:=a; lnp^.nlink:=top; top:=lnp;
+      end;
+  until endofloop(fsys+[dosy],[ident],comma,+0248);  {+0249}
+  nextif(dosy,+0250); statement(fsys);
+  top:=savtop; reglb:=savlb;
+end end;
+
+procedure assertion(fsys:sos);
+begin teststandard;
+  if opt['a']=off then
+    while not (sy in fsys) do insym
+  else
+    begin expression(fsys); force(boolptr,+0251);
+      gencst(op_loc,srcorig); gensp(ASS,2*sz_word);
+    end
+end;
+
+procedure statement; {fsys: sos}
+var lip:ip; llp:lp; lsy:symbol;
+begin
+  assert [labelsy..casesy,endsy] <= fsys;
+  assert [ident,intcst] * fsys = [];
+  if find2([intcst],fsys+[ident],+0252) then
+    begin llp:=searchlab(b.lchain,val);
+      if llp=nil then errint(+0253,val) else
+	begin if llp^.seen then errint(+0254,val) else llp^.seen:=true;
+	  newilb(llp^.labname)
+	end;
+      insym; nextif(colon1,+0255);
+    end;
+  if find2([ident,beginsy..casesy],fsys,+0256) then
+    begin if giveline then if sy<>whilesy then genlin;
+      if sy=ident then
+	if id='assert  ' then
+	  begin insym; assertion(fsys) end
+	else
+	  begin lip:=searchid([vars,field,func,proc]); insym;
+	    if lip^.klass=proc then call(fsys,lip) else assignment(fsys,lip)
+	  end
+      else
+	begin lsy:=sy; insym;
+	  case lsy of
+	    beginsy:
+	      begin compoundstatement(fsys,+0257);  {+0258}
+		nextif(endsy,+0259)
+	      end;
+	    gotosy:
+	      gotostatement;
+	    ifsy:
+	      ifstatement(fsys);
+	    casesy:
+	      begin casestatement(fsys); nextif(endsy,+0260) end;
+	    whilesy:
+	      whilestatement(fsys);
+	    repeatsy:
+	      repeatstatement(fsys);
+	    forsy:
+	      forstatement(fsys);
+	    withsy:
+	      withstatement(fsys);
+	  end
+	end;
+    end
+end;
+
+{===================================================================}
+
+procedure body(fsys:sos; fip:ip);
+var i,dlb,l0,l1,ssp:integer; llp:lp; spset:boolean;
+begin with b do begin
+{produce PRO}
+  genpnam(ps_pro,fip); argend;
+  gencst(ps_mes,ms_par);argcst(fip^.maxlb); argend;
+  l0:=lino; dlb:=0; trace('procentr',fip,dlb);
+{global labels}
+  llp:=lchain; spset:=false;
+  while llp<>nil do
+    begin
+      if llp^.labdlb<>0 then
+	begin
+	  if not spset then
+	    begin spset:=true;
+	      gencst(ps_mes,ms_gto); argend;
+	      temporary(nilptr,-1); ssp:=a.pos.ad;
+	      gencst(op_lor,1); store
+	    end;
+	  argdlb(llp^.labdlb); lino:=lino+1; genop(ps_rom);
+	  argilb(llp^.labname); argcst(ssp); argend;
+	end;
+      llp:=llp^.nextlp
+    end;
+{the body itself}
+  currproc:=fip;
+  compoundstatement(fsys,+0261);  {+0262}
+  trace('procexit',fip,dlb);
+{undefined labels}
+  llp:=lchain;
+  while llp<>nil do
+    begin if not llp^.seen then errint(+0263,llp^.labval);
+      llp:=llp^.nextlp
+    end;
+{finish and close files}
+  treewalk(top^.fname);
+  if level=1 then
+    begin l1:=lino;
+      genop(op_fil); argdlb(fildlb);  {temporarily}
+      dlb:=newdlb; gencst(ps_con,argc+1);
+      for i:=0 to argc do with argv[i] do
+	begin argcst(ad);
+	  if (ad=-1) and (i>1) then errid(+0264,name)
+	end;
+      argend; gencst(op_lxl,0); laedlb(dlb); gencst(op_lae,0);
+      gencst(op_lxa,0); gensp(INI,4*sz_addr);
+      exchange(l0,l1); gencst(op_loc,0); gensp(HLT,0)
+    end
+  else
+    begin inita(fip^.idtype,fip^.pfpos.ad);
+      if fip^.klass=func then
+	begin load;
+	  if not (assigned in fip^.iflag) then
+	    errid(-(+0265),fip^.name);
+	end;
+      genasp(op_ret);
+    end;
+  gencst(ps_end,-minlb);
+end end;
+
+{===================================================================}
+
+procedure block;  {forward declared}
+begin with b do begin
+  assert [labelsy..withsy] <= fsys;
+  assert [ident,intcst,casesy,endsy,period] * fsys = [];
+  if find3(labelsy,fsys,+0266) then labeldeclaration(fsys);
+  if find3(constsy,fsys,+0267) then constdefinition(fsys);
+  if find3(typesy,fsys,+0268) then typedefinition(fsys);
+  if find3(varsy,fsys,+0269) then vardeclaration(fsys);
+  if fip=progp then
+    begin
+      if iop[true]<>nil then
+	begin argv[1].ad:=posaddr(holeb,textptr,false);
+	  iop[true]^.vpos.ad:=argv[1].ad
+	end;
+      if iop[false]<>nil then
+	begin argv[0].ad:=posaddr(holeb,textptr,false);
+	  iop[false]^.vpos.ad:=argv[0].ad
+	end;
+      genhol; genpnam(ps_exp,fip);
+    end;  {externals are also extern for the main body}
+  fip^.pfpos.ad:=negaddr(fip^.idtype);  {function result area}
+  while find2([procsy,funcsy],fsys,+0270) do pfdeclaration(fsys);
+  if forwcount<>0 then error(+0271);  {forw proc not specified}
+  nextif(beginsy,+0272);
+  body(fsys+[casesy,endsy],fip);
+  nextif(endsy,+0273);
+end end;
+
+{===================================================================}
+
+procedure programme(fsys:sos);
+var stdin,stdout:boolean; p:ip;
+begin
+  nextif(progsy,+0274); nextif(ident,+0275);
+  if find3(lparent,fsys+[semicolon],+0276) then
+    begin
+      repeat
+	if sy<>ident then error(+0277) else
+	  begin stdin:=id='input   '; stdout:=id='output  ';
+	    if stdin or stdout then
+	      begin p:=newip(vars,id,textptr,nil);
+		enterid(p); iop[stdout]:=p;
+	      end
+	    else
+	      if argc<maxargc then
+		begin
+		  argc:=argc+1; argv[argc].name:=id; argv[argc].ad:=-1
+		end;
+	    insym
+	  end
+      until endofloop(fsys+[rparent,semicolon],[ident],comma,+0278);  {+0279}
+      if argc>maxargc then
+	begin error(+0280); argc:=maxargc end;
+      nextif(rparent,+0281);
+    end;
+  nextif(semicolon,+0282);
+  block(fsys,progp);
+  if opt['l']<>off then
+    begin gencst(ps_mes,ms_src); argcst(srcorig); argend end;
+  eofexpected:=true; nextif(period,+0283);
+end;
+
+procedure compile;
+var lsys:sos;
+begin lsys:=[progsy,labelsy..withsy];
+  repeat eofexpected:=false;
+    main:=find2([progsy,labelsy,beginsy..withsy],lsys,+0284);
+    if main then programme(lsys) else
+      begin
+	if find3(constsy,lsys,+0285) then constdefinition(lsys);
+	if find3(typesy,lsys,+0286) then typedefinition(lsys);
+	if find3(varsy,lsys,+0287) then vardeclaration(lsys);
+	genhol;
+	while find2([procsy,funcsy],lsys,+0288) do pfdeclaration(lsys);
+      end;
+    error(+0289);
+  until false;  { the only way out is the halt in nextln on eof }
+end;
+
+{===================================================================}
+
+procedure init1;
+var c:char;
+begin
+{reserved words}
+  rw[ 0]:='if      ';   rw[ 1]:='do      ';     rw[ 2]:='of      ';
+  rw[ 3]:='to      ';   rw[ 4]:='in      ';     rw[ 5]:='or      ';
+  rw[ 6]:='end     ';   rw[ 7]:='for     ';     rw[ 8]:='nil     ';
+  rw[ 9]:='var     ';   rw[10]:='div     ';     rw[11]:='mod     ';
+  rw[12]:='set     ';   rw[13]:='and     ';     rw[14]:='not     ';
+  rw[15]:='then    ';   rw[16]:='else    ';     rw[17]:='with    ';
+  rw[18]:='case    ';   rw[19]:='type    ';     rw[20]:='goto    ';
+  rw[21]:='file    ';   rw[22]:='begin   ';     rw[23]:='until   ';
+  rw[24]:='while   ';   rw[25]:='array   ';     rw[26]:='const   ';
+  rw[27]:='label   ';   rw[28]:='repeat  ';     rw[29]:='record  ';
+  rw[30]:='downto  ';   rw[31]:='packed  ';     rw[32]:='program ';
+  rw[33]:='function';   rw[34]:='procedur';
+{corresponding symbols}
+  rsy[ 0]:=ifsy;        rsy[ 1]:=dosy;          rsy[ 2]:=ofsy;
+  rsy[ 3]:=tosy;        rsy[ 4]:=insy;          rsy[ 5]:=orsy;
+  rsy[ 6]:=endsy;       rsy[ 7]:=forsy;         rsy[ 8]:=nilcst;
+  rsy[ 9]:=varsy;       rsy[10]:=divsy;         rsy[11]:=modsy;
+  rsy[12]:=setsy;       rsy[13]:=andsy;         rsy[14]:=notsy;
+  rsy[15]:=thensy;      rsy[16]:=elsesy;        rsy[17]:=withsy;
+  rsy[18]:=casesy;      rsy[19]:=typesy;        rsy[20]:=gotosy;
+  rsy[21]:=filesy;      rsy[22]:=beginsy;       rsy[23]:=untilsy;
+  rsy[24]:=whilesy;     rsy[25]:=arraysy;       rsy[26]:=constsy;
+  rsy[27]:=labelsy;     rsy[28]:=repeatsy;      rsy[29]:=recordsy;
+  rsy[30]:=downtosy;    rsy[31]:=packedsy;      rsy[32]:=progsy;
+  rsy[33]:=funcsy;      rsy[34]:=procsy;
+{indices into rw to find reserved words fast}
+  frw[0]:= 0; frw[1]:= 0; frw[2]:= 6; frw[3]:=15; frw[4]:=22;
+  frw[5]:=28; frw[6]:=32; frw[7]:=33; frw[8]:=35;
+{char types}
+  for c:=chr(0) to chr(maxcharord) do cs[c]:=others;
+  for c:='0' to '9' do cs[c]:=digit;
+  for c:='A' to 'Z' do cs[c]:=upper;
+  for c:='a' to 'z' do cs[c]:=lower;
+  cs[chr(ascnl)]:=layout;
+  cs[chr(ascvt)]:=layout;
+  cs[chr(ascff)]:=layout;
+  cs[chr(asccr)]:=layout;
+{characters with corresponding chartype in ASCII order}
+  cs[chr(ascht)]:=tabch;
+  cs[' ']:=layout;      cs['"']:=dquotech;      cs['''']:=quotech;
+  cs['(']:=lparentch;   cs[')']:=rparentch;     cs['*']:=star;
+  cs['+']:=plusch;      cs[',']:=commach;       cs['-']:=minch;
+  cs['.']:=periodch;    cs['/']:=slash;         cs[':']:=colonch;
+  cs[';']:=semich;      cs['<']:=lessch;        cs['=']:=equal;
+  cs['>']:=greaterch;   cs['[']:=lbrackch;      cs[']']:=rbrackch;
+  cs['^']:=arrowch;     cs['{']:=lbracech;
+{single character symbols in chartype order}
+  csy[rparentch]:=rparent;      csy[lbrackch]:=lbrack;
+  csy[rbrackch]:=rbrack;        csy[commach]:=comma;
+  csy[semich]:=semicolon;       csy[arrowch]:=arrow;
+  csy[plusch]:=plussy;          csy[minch]:=minsy;
+  csy[slash]:=slashsy;          csy[star]:=starsy;
+  csy[equal]:=eqsy;
+{pascal library mnemonics}
+  lmn[ELN ]:='_eln';    lmn[EFL ]:='_efl';      lmn[CLS ]:='_cls';
+  lmn[WDW ]:='_wdw';
+  lmn[OPN ]:='_opn';    lmn[GETX]:='_get';      lmn[RDI ]:='_rdi';
+  lmn[RDC ]:='_rdc';    lmn[RDR ]:='_rdr';      lmn[RDL ]:='_rdl';
+  lmn[RLN ]:='_rln';
+  lmn[CRE ]:='_cre';    lmn[PUTX]:='_put';      lmn[WRI ]:='_wri';
+  lmn[WSI ]:='_wsi';    lmn[WRC ]:='_wrc';      lmn[WSC ]:='_wsc';
+  lmn[WRS ]:='_wrs';    lmn[WSS ]:='_wss';      lmn[WRB ]:='_wrb';
+  lmn[WSB ]:='_wsb';    lmn[WRR ]:='_wrr';      lmn[WSR ]:='_wsr';
+  lmn[WRL ]:='_wrl';    lmn[WSL ]:='_wsl';
+  lmn[WRF ]:='_wrf';    lmn[WRZ ]:='_wrz';      lmn[WSZ ]:='_wsz';
+  lmn[WLN ]:='_wln';    lmn[PAG ]:='_pag';
+  lmn[ABR ]:='_abr';    lmn[RND ]:='_rnd';      lmn[SINX]:='_sin';
+  lmn[COSX]:='_cos';    lmn[EXPX]:='_exp';      lmn[SQT ]:='_sqt';
+  lmn[LOG ]:='_log';    lmn[ATN ]:='_atn';      lmn[ABI ]:='_abi';
+  lmn[ABL ]:='_abl';
+  lmn[BCP ]:='_bcp';    lmn[BTS ]:='_bts';      lmn[NEWX]:='_new';
+  lmn[SAV ]:='_sav';    lmn[RST ]:='_rst';      lmn[INI ]:='_ini';
+  lmn[HLT ]:='_hlt';    lmn[ASS ]:='_ass';      lmn[GTO ]:='_gto';
+  lmn[PAC ]:='_pac';    lmn[UNP ]:='_unp';      lmn[DIS ]:='_dis';
+  lmn[ASZ ]:='_asz';    lmn[MDI ]:='_mdi';      lmn[MDL ]:='_mdl';
+{scalar variables}
+  b.nextbp:=nil;
+  b.reglb:=0;
+  b.minlb:=0;
+  b.ilbno:=0;
+  b.forwcount:=0;
+  b.lchain:=nil;
+  srcchno:=0;
+  srclino:=1;
+  srcorig:=1;
+  lino:=0;
+  dlbno:=0;
+  holeb:=0;
+  argc:=1;
+  lastpfno:=0;
+  giveline:=true;
+  including:=false;
+  eofexpected:=false;
+  intypedec:=false;
+  fltused:=false;
+  seconddot:=false;
+  iop[false]:=nil;
+  iop[true]:=nil;
+  argv[0].ad:=-1;
+  argv[1].ad:=-1;
+end;
+
+procedure init2;
+var p:ip; k:idclass; j:standpf;
+    pfn:array[standpf] of idarr;
+begin
+{initialize the first name space}
+  new(top,blck); top^.occur:=blck; top^.nlink:=nil; top^.fname:=nil;
+  level:=0;
+{undefined identifier pointers used by searchid}
+  for k:=types to func do
+    undefip[k]:=newip(k,spaces,nil,nil);
+{names of standard procedures/functions}
+  pfn[pread     ]:='read    ';  pfn[preadln     ]:='readln  ';
+  pfn[pwrite    ]:='write   ';  pfn[pwriteln    ]:='writeln ';
+  pfn[pput      ]:='put     ';  pfn[pget        ]:='get     ';
+  pfn[ppage     ]:='page    ';  pfn[preset      ]:='reset   ';
+  pfn[prewrite  ]:='rewrite ';  pfn[pnew        ]:='new     ';
+  pfn[pdispose  ]:='dispose ';  pfn[ppack       ]:='pack    ';
+  pfn[punpack   ]:='unpack  ';  pfn[pmark       ]:='mark    ';
+  pfn[prelease  ]:='release ';  pfn[phalt       ]:='halt    ';
+  pfn[feof      ]:='eof     ';  pfn[feoln       ]:='eoln    ';
+  pfn[fabs      ]:='abs     ';  pfn[fsqr        ]:='sqr     ';
+  pfn[ford      ]:='ord     ';  pfn[fchr        ]:='chr     ';
+  pfn[fpred     ]:='pred    ';  pfn[fsucc       ]:='succ    ';
+  pfn[fodd      ]:='odd     ';  pfn[ftrunc      ]:='trunc   ';
+  pfn[fround    ]:='round   ';  pfn[fsin        ]:='sin     ';
+  pfn[fcos      ]:='cos     ';  pfn[fexp        ]:='exp     ';
+  pfn[fsqt      ]:='sqrt    ';  pfn[flog        ]:='ln      ';
+  pfn[fatn      ]:='arctan  ';
+{standard procedure/function identifiers}
+  for j:=pread to phalt do
+    begin new(p,proc,standard); p^.klass:=proc;
+      p^.name:=pfn[j]; p^.pfkind:=standard; p^.key:=j; enterid(p);
+    end;
+  for j:=feof to fatn do
+    begin new(p,func,standard); p^.klass:=func; p^.idtype:=nil;
+      p^.name:=pfn[j]; p^.pfkind:=standard; p^.key:=j; enterid(p);
+    end;
+{program identifier}
+  progp:=newip(proc,'m_a_i_n ',nil,nil);
+end;
+
+procedure init3;
+var n:np; p,q:ip; i:integer; c:char;
+begin
+  for i:=0 to sz_last do readln(errors,sizes[i]);
+  gencst(ps_mes,ms_emx); argcst(sz_word); argcst(sz_addr); argend;
+  ix:=1;
+  while not eoln(errors) do
+    begin read(errors,c);
+      if ix<smax then begin strbuf[ix]:=c; ix:=ix+1 end
+    end;
+  readln(errors); strbuf[ix]:=chr(0);
+  for i:=1 to fnmax do
+    if i<ix then source[i]:=strbuf[i] else source[i]:=' ';
+  fildlb:=romstr(sp_scon,0);
+{standard type pointers}
+  intptr :=newsp(scalar,sz_int);
+  realptr:=newsp(scalar,sz_real);
+  longptr:=newsp(scalar,sz_long);
+  charptr:=newsp(scalar,sz_char);
+  boolptr:=newsp(scalar,sz_bool);
+  nilptr :=newsp(pointer,sz_addr);
+  zeroptr:=newsp(pointer,sz_addr);
+  procptr:=newsp(records,sz_proc);
+  nullset:=newsp(power,sz_word); nullset^.elset:=nil;
+  textptr:=newsp(files,sz_head+sz_buff); textptr^.filtype:=charptr;
+{standard type names}
+  enterid(newip(types,'integer ',intptr,nil));
+  enterid(newip(types,'real    ',realptr,nil));
+  enterid(newip(types,'char    ',charptr,nil));
+  enterid(newip(types,'boolean ',boolptr,nil));
+  enterid(newip(types,'text    ',textptr,nil));
+{standard constant names}
+  q:=nil; p:=newip(konst,'false   ',boolptr,q); enterid(p);
+  q:=p; p:=newip(konst,'true    ',boolptr,q); p^.value:=1; enterid(p);
+  boolptr^.fconst:=p;
+  p:=newip(konst,'maxint  ',intptr,nil); p^.value:=MI2; enterid(p);
+  p:=newip(konst,spaces,charptr,nil); p^.value:=maxcharord;
+  charptr^.fconst:=p;
+{new name space for user externals}
+  new(n,blck); n^.occur:=blck; n^.nlink:=top; n^.fname:=nil; top:=n;
+{options}
+  for c:='a' to 'z' do begin opt[c]:=0; forceopt[c]:=false end;
+  opt['a']:=on;
+  opt['i']:=NB1*sz_iset;
+  opt['l']:=on;
+  opt['o']:=on;
+  opt['r']:=on;
+  sopt:=off;
+end;
+
+procedure init4;
+begin
+  copt:=opt['c'];
+  dopt:=opt['d'];
+  iopt:=opt['i'];
+  sopt:=opt['s'];
+  if sopt<>off then begin copt:=off; dopt:=off end
+  else if opt['u']<>off then cs['_']:=lower;
+  if copt<>off then enterid(newip(types,'string  ',zeroptr,nil));
+  if dopt<>off then enterid(newip(types,'long    ',longptr,nil));
+  if opt['o']=off then begin gencst(ps_mes,ms_opt); argend end;
+  if dopt<>off then fltused:=true;  {temporary kludge}
+end;
+
+begin  {main body of pcompiler}
+  init1;  {initialize tables and scalars}
+  init2;  {initialize heap objects}
+  rewrite(em); put2(sp_magic); reset(errors);
+  init3;  {size dependent initialization}
+  while not eof(errors) do
+    begin options(false); readln(errors) end;
+  rewrite(errors);
+  if not eof(input) then
+    begin nextch; insym;
+      init4;  {option dependent initialization}
+      compile
+    end;
+#ifdef STANDARD
+9999: ;
+#endif
+end.  {pcompiler}

+ 27 - 0
lib/6500/descr

@@ -0,0 +1,27 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=m6500
+var M=6500
+var LIB=mach/6500/lib/tail_
+var RT=mach/6500/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_be
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) -o > (.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 31 - 0
lib/6809/descr

@@ -0,0 +1,31 @@
+var w=2
+var i=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=m6809
+var M=6809
+var LIB=mach/6809/lib/tail_
+var RT=mach/6809/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_be
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 25 - 0
lib/descr/cpm

@@ -0,0 +1,25 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=4
+var M=cpm
+var NAME=CPM
+var LIB=mach/z80/int/lib/tail_
+var RT=mach/z80/int/lib/head_
+var SIZE_F=-sm
+var INCLUDES=-I{EM}/include -I/usr/include
+name asld
+	from .k.m.a
+	to e.out
+	program {EM}/lib/em_ass
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -+* ASS_F={ASS_F?} -+*
+	mapflag --* ASS_F={ASS_F?} --*
+	mapflag -s* SIZE_F=-s*
+	args {ASS_F?} ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c.p:{TAIL}={EM}/{LIB}mon)
+	prop C
+end

+ 60 - 0
lib/descr/fe.src

@@ -0,0 +1,60 @@
+# (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+name cpp
+	# no from, it's governed by the P property
+	to .i
+	program {EM}/lib/cpp.new
+	mapflag -I* CPP_F={CPP_F?} -I*
+	mapflag -U* CPP_F={CPP_F?} -U*
+	mapflag -D* CPP_F={CPP_F?} -D*
+	args {CPP_F?} {INCLUDES?} -D{NAME} -DEM_WSIZE={w} -DEM_PSIZE={p} \
+-DEM_SSIZE={s} -DEM_LSIZE={l} -DEM_FSIZE={f} -DEM_DSIZE={d} <
+	prop >P
+end
+name cem
+	from .c
+	to .k
+	program {EM}/lib/em_cem
+	mapflag -p CEM_F={CEM_F?} -Xp
+	mapflag -L CEM_F={CEM_F?} -l
+	args -Vw{w}i{w}p{p}f{f}s{s}l{l}d{d} {CEM_F?}
+	prop <>p
+	rts .c
+	need .c
+end
+name pc
+	from .p
+	to .k
+	program {EM}/lib/em_pc
+	mapflag -p PC_F={PC_F?} -p
+	mapflag -w PC_F={PC_F?} -w
+	mapflag -E PC_F={PC_F?} -E
+	mapflag -e PC_F={PC_F?} -e
+	mapflag -{*} PC_F={PC_F?} -\{*}
+	mapflag -L PC_F={PC_F?} -\{l-}
+	args -Vw{w}p{p}f{d}l{l} {PC_F?} < > {SOURCE}
+	prop m
+	rts .p
+	need .p
+ end
+ name encode
+	from .e
+	to .k
+	program {EM}/lib/em_encode
+	args <
+	prop >m
+end
+name opt
+	from .k
+	to .m
+	program {EM}/lib/em_opt
+	mapflag -LIB OPT_F={OPT_F?} -L
+	args {OPT_F?} <
+	prop >O
+end
+name decode
+	from .k.m
+	to .e
+	program {EM}/lib/em_decode
+	args <
+	prop >
+end

+ 35 - 0
lib/descr/ibm.nosid

@@ -0,0 +1,35 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=i8086
+var M=i86
+var LIB=mach/i86/lib/tail_
+var LIBIBM=mach/ibm/lib/tail_
+var RT=mach/i86/lib/head_
+var RTIBM=mach/ibm/lib/head_
+var INCLUDES=-I{EM}/include -I{EM}/mach/ibm/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -i  IFILE={EM}/{RT}i
+	args {IFILE?} (.e:{HEAD}={EM}/{RTIBM}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.e:{TAIL}={EM}/{LIBIBM}em) \
+(.c.p:{TAIL}={EM}/{LIBIBM}mon) \
+(.e:{TAIL}={EM}/{LIBIBM}em.vend)
+	prop C
+end

+ 34 - 0
lib/descr/m68k2.macs

@@ -0,0 +1,34 @@
+var w=2
+var p=4
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=m68k2
+var M=m68k2
+var LIBDIR=mach/m68k2/lib
+var LIB=mach/m68k2/lib/tail_
+var RT=mach/m68k2/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p.c:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \
+(.c:{TAIL}={EM}/{LIBDIR}/write.s) \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \
+(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend)
+	prop Cm
+end

+ 28 - 0
lib/descr/nascom

@@ -0,0 +1,28 @@
+var w=1
+var p=2
+var s=1
+var l=2
+var f=4
+var d=8
+var NAME=nascom
+var M=z80a
+var LIB=mach/z80a/lib/tail_
+var RT=mach/z80a/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_be
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) ({RTS}:.c={EM}/{RT}cc) -o > \
+(.e:{TAIL}={EM}/{LIB}em.1 {EM}/{LIB}em.2)
+	prop C
+end

+ 32 - 0
lib/descr/net86

@@ -0,0 +1,32 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=i8086
+var M=i86
+var LIB=mach/i86/lib/tail_
+var RT=mach/i86/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -i  IFILE={EM}/{RT}i
+	args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c.p.e:{TAIL}={EM}/{LIB}netio) (.c.p.e:{TAIL}={EM}/{LIB}alo) \
+(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 33 - 0
lib/descr/sat86

@@ -0,0 +1,33 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=i8086
+var M=i86
+var LIB=mach/i86/lib/tail_
+var ALIB=mach/i86/lib/sat_tail_
+var RT=mach/i86/lib/head_
+var ART=mach/i86/lib/sat_head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{ART}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c.p:{TAIL}={EM}/{ALIB}mon) (.c.p.e:{TAIL}={EM}/{LIB}alo) \
+(.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 27 - 0
lib/em22/descr

@@ -0,0 +1,27 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var M=int
+var NAME=int22
+var LIB=mach/int/lib/tail_
+var RT=mach/int/lib/head_
+var SIZE_FLAG=-sm
+var INCLUDES=-I{EM}/include -I/usr/include
+name asld
+	from .k.m.a
+	to e.out
+	program {EM}/lib/em_ass
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -+* ASS_F={ASS_F?} -+*
+	mapflag --* ASS_F={ASS_F?} --*
+	mapflag -s* SIZE_FLAG=-s*
+	args {SIZE_FLAG} \
+		({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+		(.p:{TAIL}={EM}/{LIB}pc) \
+		(.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+		(.c.p:{TAIL}={EM}/{LIB}mon)
+	prop C
+end

+ 27 - 0
lib/i80/descr

@@ -0,0 +1,27 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=i8080
+var M=8080
+var LIB=mach/8080/lib/tail_
+var RT=mach/8080/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_be
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args ({RTS}:.c={EM}/{RT}cc) -o > <
+	prop C
+end

+ 32 - 0
lib/i86/descr

@@ -0,0 +1,32 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=i8086
+var M=i86
+var LIB=mach/i86/lib/tail_
+var RT=mach/i86/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -i  IFILE={EM}/{RT}i
+	args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c.p.e:{TAIL}={EM}/{LIB}alo) (.c.p:{TAIL}={EM}/{LIB}mon) \
+(.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 30 - 0
lib/m68k2/descr

@@ -0,0 +1,30 @@
+var w=2
+var p=4
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=m68k2
+var M=m68k2
+var LIB=mach/m68k2/lib/tail_
+var RT=mach/m68k2/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon {EM}/{LIB}em.vend)
+	prop Cm
+end

+ 34 - 0
lib/m68k4/descr

@@ -0,0 +1,34 @@
+var w=4
+var p=4
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=m68k4
+var M=m68k4
+var LIBDIR=mach/m68k4/lib
+var LIB=mach/m68k4/lib/tail_
+var RT=mach/m68k4/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p.c:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \
+(.c:{TAIL}={EM}/{LIBDIR}/write.s) \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \
+(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend)
+	prop Cm
+end

+ 38 - 0
lib/pdp/descr

@@ -0,0 +1,38 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var M=pdp
+var NAME=pdp
+var LIB=mach/pdp/lib/tail_
+var RT=mach/pdp/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name as
+	from .s
+	to .o
+	program /bin/as
+	args - -o > <
+	prop m
+end
+name ld
+	from .o.a
+	to a.out
+	program /bin/ld
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) \
+		({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+		(.p:{TAIL}={EM}/{LIB}pc) \
+		(.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+		(.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}=/lib/libc.a)
+	prop C
+end

+ 32 - 0
lib/pmds/descr

@@ -0,0 +1,32 @@
+var w=2
+var p=4
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=m68k2
+var M=m68k2
+var LIB=mach/m68k2/lib/tail_
+var RT=mach/m68k2/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .o
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .o.s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -i
+	mapflag -n
+	args (.e:{HEAD}={EM}/{RT}em.pmds) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon.pmds {EM}/{LIB}em.vend)
+	prop Cm
+end

+ 44 - 0
lib/vax4/descr.src

@@ -0,0 +1,44 @@
+var w=4
+var p=4
+var s=2
+var l=4
+var f=4
+var d=8
+var M=vax4
+var NAME=vax4
+var LIB=mach/vax4/lib/tail_
+var RT=mach/vax4/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asopt
+	from .s
+	to .so
+	program /bin/sed
+	args -f {EM}/mach/vax4/cg/sedf
+	prop O<>
+end
+name as
+	from .s.so
+	to .o
+	program /bin/as
+	args - -o > <
+	prop m
+end
+name ld
+	from .o.a
+	to a.out
+	program /bin/ld
+	mapflag -l* LNAME={EM}/{LIB}*
+	args (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 31 - 0
lib/z80/descr

@@ -0,0 +1,31 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=z80
+var M=z80
+var LIB=mach/z80/lib/tail_
+var RT=mach/z80/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -i  IFILE={EM}/{RT}i
+	args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.p.c:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 31 - 0
lib/z8000/descr

@@ -0,0 +1,31 @@
+var w=2
+var p=2
+var s=2
+var l=4
+var f=4
+var d=8
+var NAME=z8000
+var M=z8000
+var LIB=mach/z8000/lib/tail_
+var RT=mach/z8000/lib/head_
+var INCLUDES=-I{EM}/include -I/usr/include
+name be
+	from .m
+	to .s
+	program {EM}/lib/{M}_cg
+	args <
+	prop >
+	need .e
+end
+name asld
+	from .s.a
+	to a.out
+	program {EM}/lib/{M}_as
+	mapflag -l* LNAME={EM}/{LIB}*
+	mapflag -i  IFILE={EM}/{RT}i
+	args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
+({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
+(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
+(.p.c:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
+	prop C
+end

+ 178 - 0
mach/6500/cg/Makefile

@@ -0,0 +1,178 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../install cg
+
+cmp:	 all
+	-../compare cg
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	../../../lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

+ 178 - 0
mach/pdp/cg/Makefile

@@ -0,0 +1,178 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../install cg
+
+cmp:	 all
+	-../compare cg
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	../../../lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

+ 171 - 0
mach/pdp/cg/mach.c

@@ -0,0 +1,171 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+/*
+ * machine dependent back end routines for the PDP-11
+ */
+
+#define REGPATCH
+
+con_part(sz,w) register sz; word w; {
+
+	while (part_size % sz)
+		part_size++;
+	if (part_size == EM_WSIZE)
+		part_flush();
+	if (sz == 1) {
+		w &= 0xFF;
+		if (part_size)
+			w <<= 8;
+		part_word |= w;
+	} else {
+		assert(sz == 2);
+		part_word = w;
+	}
+	part_size += sz;
+}
+
+con_mult(sz) word sz; {
+	long l;
+
+	if (sz != 4)
+		fatal("bad icon/ucon size");
+	l = atol(str);
+	fprintf(codefile,"\t%o;%o\n",(int)(l>>16),(int)l);
+}
+
+con_float() {
+	double f;
+	register short *p,i;
+
+	if (argval != 4 && argval != 8)
+		fatal("bad fcon size");
+	f = atof(str);
+	p = (short *) &f;
+	i = *p++;
+	if (argval == 8) {
+		fprintf(codefile,"\t%o;%o;",i,*p++);
+		i = *p++;
+	}
+	fprintf(codefile,"\t%o;%o\n",i,*p++);
+}
+
+#ifdef REGVARS
+
+char Rstring[10] = "RT";
+
+regscore(off,size,typ,score,totyp) long off; {
+
+	if (size != 2)
+		return(-1);
+	score -= 1;	/* allow for save/restore */
+	if (off>=0)
+		score -= 2;
+	if (typ==reg_pointer)
+		score *= 17;
+	else if (typ==reg_loop)
+		score = 10*score+50;	/* Guestimate */
+	else
+		score *= 10;
+	return(score);	/* estimated # of words of profit */
+}
+
+i_regsave() {
+
+	Rstring[2] = 0;
+}
+
+f_regsave() {}
+
+regsave(regstr,off,size) char *regstr; long off; {
+
+	fprintf(codefile,"/ Local %ld into %s\n",off,regstr);
+#ifndef REGPATCH
+	fprintf(codefile,"mov %s,-(sp)\n",regstr);
+#endif
+	strcat(Rstring,regstr);
+	if (off>=0)
+		fprintf(codefile,"mov 0%lo(r5),%s\n",off,regstr);
+}
+
+regreturn() {
+
+#ifdef REGPATCH
+	fprintf(codefile,"jmp eret\n");
+#else
+	fprintf(codefile,"jmp %s\n",Rstring);
+#endif
+}
+
+#endif
+
+prolog(nlocals) full nlocals; {
+
+#ifdef REGPATCH
+	fprintf(codefile,"mov r2,-(sp)\nmov r4,-(sp)\n");
+#endif
+	fprintf(codefile,"mov r5,-(sp)\nmov sp,r5\n");
+	if (nlocals == 0)
+		return;
+	if (nlocals == 2)
+		fprintf(codefile,"tst -(sp)\n");
+	else
+		fprintf(codefile,"sub $0%o,sp\n",nlocals);
+}
+
+dlbdlb(as,ls) string as,ls; {
+
+	if (strlen(as)+strlen(ls)+2<sizeof(labstr)) {
+		strcat(ls,":");
+		strcat(ls,as);
+	} else
+		fatal("too many consecutive labels");
+}
+
+mes(type) word type; {
+	int argt ;
+
+	switch ( (int)type ) {
+	case ms_ext :
+		for (;;) {
+			switch ( argt=getarg(
+			    ptyp(sp_cend)|ptyp(sp_pnam)|sym_ptyp) ) {
+			case sp_cend :
+				return ;
+			default:
+				strarg(argt) ;
+				fprintf(codefile,".globl %s\n",argstr) ;
+				break ;
+			}
+		}
+	default :
+		while ( getarg(any_ptyp) != sp_cend ) ;
+		break ;
+	}
+}
+
+char    *segname[] = {
+	".text",        /* SEGTXT */
+	".data",        /* SEGCON */
+	".data",        /* SEGROM */
+	".bss"          /* SEGBSS */
+};

+ 23 - 0
mach/pdp/cg/mach.h

@@ -0,0 +1,23 @@
+/* $Header$ */
+
+#define ex_ap(y)	fprintf(codefile,"\t.globl %s\n",y)
+#define in_ap(y)	/* nothing */
+
+#define newilb(x)	fprintf(codefile,"%s:\n",x)
+#define newdlb(x)	fprintf(codefile,"%s:\n",x)
+#define newlbss(l,x)	fprintf(codefile,"%s:.=.+0%o\n",l,x);
+
+#define cst_fmt		"$0%o"
+#define off_fmt		"0%o"
+#define ilb_fmt		"I%02x%x"
+#define dlb_fmt		"_%d"
+#define	hol_fmt		"hol%d"
+
+#define hol_off		"0%o+hol%d"
+
+#define con_cst(x)	fprintf(codefile,"0%o\n",x)
+#define con_ilb(x)	fprintf(codefile,"%s\n",x)
+#define con_dlb(x)	fprintf(codefile,"%s\n",x)
+
+#define id_first	'_'
+#define BSS_INIT	0

+ 2450 - 0
mach/pdp/cg/table

@@ -0,0 +1,2450 @@
+"$Header$"
+/********************************************************
+ * Back end tables for pdp 11                           *
+ * Authors : Ceriel J.H. Jacobs,Hans van Staveren       *
+ *                                                      *
+ * wordsize = 2 bytes, pointersize = 2 bytes.           *
+ *                                                      *
+ * Register r5 is used for the LB, the stack pointer    *
+ * is used for SP. Also some global variables are used: *
+ * - reghp~     : the heap pointer                      *
+ * - trpim~     : trap ignore mask                      *
+ * - trppc~     : address of user defined trap handler  *
+ * - retar	: function return area for size>4       *
+ *                                                      *
+ * Timing is based on the timing information available  *
+ * for the 11/45. Hardware floating point processor is  *
+ * assumed.                                             *
+ ********************************************************/
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#define REGPATCH		/* save all registers in link block */
+
+#ifdef REGPATCH
+#define SL 8
+#define SSL "010"
+#else REGPATCH
+#define SL 4
+#define SSL "4"
+#endif REGPATCH
+
+#define NC nocoercions:
+
+/* options */
+/* #define DORCK	/* rck is expanded instead of thrown away */
+#define REGVARS		/* use register variables */
+
+EM_WSIZE=2
+EM_PSIZE=2
+EM_BSIZE=SL
+
+TIMEFACTOR= 1/300
+FORMAT="0%o"
+
+REGISTERS:
+r0      = ("r0", 2), REG.
+r1      = ("r1", 2), REG, ODD_REG.
+#ifdef REGVARS
+r2	= ("r2", 2) regvar, REG.
+#else
+/* r2      = ("r2", 2), REG. */
+#endif
+r3      = ("r3", 2), REG, ODD_REG.
+#ifdef REGVARS
+r4	= ("r4", 2) regvar, REG.
+#else
+/* r4      = ("r4", 2), REG. */
+#endif
+lb      = ("r5", 2), localbase.
+r01     = ("r0", 4, r0, r1), REG_PAIR.
+#ifndef REGVARS
+/* r23     = ("r2", 4, r2, r3), REG_PAIR. */
+#endif
+fr0     = ("fr0", 4), FLT_REG.
+fr1     = ("fr1", 4), FLT_REG.
+fr2     = ("fr2", 4), FLT_REG.
+fr3     = ("fr3", 4), FLT_REG.
+fr01    = ("fr0", 8, fr0, fr1), FLT_REG_PAIR.
+fr23    = ("fr2", 8, fr2, fr3), FLT_REG_PAIR.
+dr0     = ("fr0", 8, fr0), DBL_REG.
+dr1     = ("fr1", 8, fr1), DBL_REG.
+dr2     = ("fr2", 8, fr2), DBL_REG.
+dr3     = ("fr3", 8, fr3), DBL_REG.
+dr01    = ("fr0", 16, dr0, dr1), DBL_REG_PAIR.
+dr23    = ("fr2", 16, dr2, dr3), DBL_REG_PAIR.
+
+TOKENS:
+
+/********************************
+ * Types on the EM-machine      *
+ ********************************/
+
+CONST2          = {INT num;}    2 cost=(2,300) "$%[num]"
+LOCAL2          = {INT ind,size;}       2 cost=(2,600) "%[ind](r5)"
+LOCAL4          = {INT ind,size;}       4 cost=(2,1200) "%[ind](r5)"
+ADDR_LOCAL      = {INT ind;}    2
+ADDR_EXTERNAL   = {STRING ind;} 2 cost=(2,300)  "$%[ind]"
+
+/********************************************************
+ * Now mostly addressing modes of target machine        *
+ ********************************************************/
+
+regdef2 =       {REGISTER reg;} 2 cost=(0,300) "*%[reg]"
+regind2 =       {REGISTER reg; STRING ind;} 2 cost=(2,600) "%[ind](%[reg])"
+reginddef2 =    {REGISTER reg; STRING ind;} 2 cost=(2,1050) "*%[ind](%[reg])"
+regconst2 =     {REGISTER reg; STRING ind;} 2
+/********************************************************
+ * This means : add "reg" and "ind" to get address.     *
+ * Not really addressable on the PDP 11                 *
+ ********************************************************/
+relative2 =     {STRING ind;} 2 cost=(2,600) "%[ind]"
+reldef2 =       {STRING ind;} 2 cost=(2,1050) "*%[ind]"
+regdef1 =       {REGISTER reg;} 2 cost=(0,300) "*%[reg]"
+regind1 =       {REGISTER reg; STRING ind;} 2 cost=(2,600) "%[ind](%[reg])"
+reginddef1 =    {REGISTER reg; STRING ind;} 2 cost=(2,1050) "*%[ind](%[reg])"
+relative1 =     {STRING ind;} 2 cost=(2,600) "%[ind]"
+reldef1 =       {STRING ind;} 2 cost=(2,1050) "*%[ind]"
+
+/************************************************************************
+ * fto* are floats converted to *, conversion is delayed to be combined *
+ * with store.								*
+ ************************************************************************/
+
+ftoint =	{REGISTER reg;} 2
+ftolong =	{REGISTER reg;} 4
+
+/************************************************************************
+ * ...4 and ...8 are only addressable by the floating point processor.    *
+ ************************************************************************/
+
+regind4 =       {REGISTER reg; STRING ind; } 4 cost=(2,3630) "%[ind](%[reg])"
+relative4 =     {STRING ind; } 4 cost=(2,3630) "%[ind]"
+regdef4 =       {REGISTER reg;} 4 cost=(2,3240) "*%[reg]"
+regdef8 =       {REGISTER reg;} 8 cost=(2,5220) "*%[reg]"
+relative8 =     {STRING ind; } 8 cost=(2,5610) "%[ind]"
+regind8 =       {REGISTER reg; STRING ind;} 8 cost=(2,5610) "%[ind](%[reg])"
+
+TOKENEXPRESSIONS:
+SCR_REG =       REG * SCRATCH
+SCR_FLT_REG =   FLT_REG * SCRATCH
+SCR_DBL_REG =   DBL_REG * SCRATCH
+SCR_ODD_REG =   ODD_REG * SCRATCH
+SCR_REG_PAIR =  REG_PAIR * SCRATCH
+all=            ALL 
+source2 =       REG + regdef2 + regind2 + reginddef2 + localbase + 
+		relative2 + reldef2 + ADDR_EXTERNAL + CONST2 + LOCAL2 
+xsource2 =	source2 + ftoint
+source1 =       regdef1 + regind1 + reginddef1 + relative1 +
+		reldef1
+source1or2 =    source1 + source2
+long4 =         relative4 + regdef4 + LOCAL4 + regind4 + REG_PAIR
+longf4 =        long4 + FLT_REG - REG_PAIR
+double8 =       relative8 + regdef8 + regind8 + DBL_REG
+indexed2 =      regind2 + reginddef2
+indexed4 =      regind4
+indexed8 =      regind8
+indexed  =      indexed2 + indexed4 + indexed8
+regdeferred =   regdef2 + regdef4 + regdef8
+indordef =      indexed + regdeferred
+locals =        LOCAL2 + LOCAL4 
+variable2 =     relative2 + reldef2
+variable4 =     relative4
+variable8 =     relative8
+variable  =     variable2 + variable4 + variable8
+dadres2 =       relative2 + REG + regind2
+regs =          REG + REG_PAIR + FLT_REG + FLT_REG_PAIR +
+		DBL_REG + DBL_REG_PAIR
+noconst2 =	source2 - CONST2 - ADDR_EXTERNAL
+allexeptcon =   all - regs - CONST2 - ADDR_LOCAL - ADDR_EXTERNAL
+externals =	relative1 + relative2 + relative4 + relative8
+posextern =	variable + regdeferred + indexed + externals
+diradr2 =       regconst2 + ADDR_EXTERNAL
+
+#ifdef REGVARS
+#define INDSTORE remove(allexeptcon-locals) remove(locals, inreg(%[ind])==0)
+#else
+#define INDSTORE remove(allexeptcon)
+#endif
+
+CODE:
+
+/********************************************************
+ * Group 1 : load instructions.                         *
+ *                                                      *
+ * For most load instructions no code is generated.     *
+ * Action : put something on the fake-stack.            *
+ ********************************************************/
+
+loc             | |             | {CONST2, $1}                          | |
+ldc             | |             | {CONST2, loww(1)}  {CONST2, highw(1)}	| |
+#ifdef REGVARS
+lol inreg($1)==2| |		| regvar($1)			| |
+#endif
+lol             | |             | {LOCAL2, $1,2}                        | |
+loe             | |             | {relative2, $1}                       | |
+#ifdef REGVARS
+lil inreg($1)==2| |		| {regdef2, regvar($1)}		| |
+#endif
+lil             | |             | {reginddef2, lb, tostring($1)}    | |
+lof		| REG         | | {regind2,%[1],tostring($1)}       | |
+...		| NC regconst2 |
+		 | {regind2,%[1.reg],tostring($1)+"+"+%[1.ind]}        | |
+...             | NC ADDR_EXTERNAL |
+		 | {relative2,tostring($1)+"+"+%[1.ind]} 		| |
+...             | NC ADDR_LOCAL |  | {LOCAL2, %[1.ind] + $1,2}		| |
+#ifdef REGVARS
+lol lof inreg($1)!=2 | |
+			allocate(REG={LOCAL2, $1,2})
+				| {regind2,%[a],tostring($2)}	| |
+#endif
+lal             | |             | {ADDR_LOCAL, $1}                      | |
+lae             | |             | {ADDR_EXTERNAL, $1}                   | |
+lpb		| |		|			| adp SL  	  |
+lxl $1==0       | |             | lb                           	| |
+lxl $1==1       | |             | {LOCAL2 ,SL,2}                        | |
+lxl $1==2       | |     allocate(REG={LOCAL2, SL, 2})
+				| {regind2,%[a], SSL}                   | |
+lxl $1==3	| |	allocate(REG={LOCAL2, SL, 2})
+			move({regind2,%[a], SSL},%[a])
+				| {regind2,%[a], SSL}                   | |
+lxl $1>3        | |     allocate(REG={LOCAL2, SL, 2}, REG={CONST2,$1-1})
+			"1:"
+			move({regind2,%[a], SSL},%[a])
+			"sob %[b],1b"
+			setcc(%[a]) erase(%[a]) erase(%[b])
+				| %[a]                                  | |
+lxa $1==0       | |             | {ADDR_LOCAL, SL}                      | |
+lxa $1==1       | |     allocate(REG={LOCAL2, SL, 2 })
+				| {regconst2, %[a], SSL }               | |
+lxa $1==2       | |     allocate(REG={LOCAL2, SL, 2 })
+			move({regind2, %[a], SSL }, %[a])
+				| {regconst2, %[a], SSL }               | |
+lxa $1==3       | |     allocate(REG={LOCAL2, SL, 2 })
+			move({regind2, %[a], SSL }, %[a])
+			move({regind2, %[a], SSL }, %[a])
+				| {regconst2, %[a], SSL }               | |
+lxa $1 > 3      | |     allocate(REG={LOCAL2, SL, 2}, REG={CONST2,$1-1})
+			"1:"
+			move({regind2,%[a], SSL},%[a])
+			"sob %[b],1b"
+			setcc(%[a]) erase(%[a]) erase(%[b])
+				| {regconst2, %[a], SSL }               | |
+dch		| |		|                              | loi 2    |
+loi $1==2       | REG |            | {regdef2, %[1]}                    | |
+...             | NC regconst2 |   | {regind2, %[1.reg], %[1.ind]}      | |
+...             | NC relative2 |   | {reldef2, %[1.ind]}                | |
+...             | NC regind2 |     | {reginddef2, %[1.reg], %[1.ind]}   | |
+...		| NC regdef2 |	   | {reginddef2, %[1.reg], "0"}| |
+...             | NC ADDR_LOCAL |  | {LOCAL2, %[1.ind],2}               | |
+...             | NC ADDR_EXTERNAL | | {relative2, %[1.ind]}            | |
+...             | NC LOCAL2 |
+		               |{reginddef2, lb, tostring(%[1.ind])}| |
+loi $1==1       | REG |         | {regdef1, %[1]}                       | |
+...             | NC regconst2 |   | {regind1, %[1.reg], %[1.ind]}      | |
+...             | NC ADDR_EXTERNAL | | {relative1, %[1.ind]}            | |
+...		| NC ADDR_LOCAL| |{regind1, lb, tostring(%[1.ind])} | |
+...             | NC relative2 |   | {reldef1, %[1.ind]}                | |
+...             | NC regind2 |     | {reginddef1, %[1.reg], %[1.ind]}   | |
+...		| NC regdef2 |	   | {reginddef1, %[1.reg], "0"}| |
+...		| NC LOCAL2 | |{reginddef1, lb, tostring(%[1.ind])} | |
+loi $1==4       | REG |         | {regdef4, %[1]}                       | |
+...             | NC regconst2 |   | {regind4, %[1.reg], %[1.ind]}      | |
+...             | NC ADDR_LOCAL |  | {LOCAL4,%[1.ind],4}                | |
+...             | NC ADDR_EXTERNAL | | {relative4, %[1.ind]}            | |
+loi $1==8       | REG |         | {regdef8, %[1]}                       | |
+...             | NC regconst2 |   | {regind8, %[1.reg], %[1.ind]}      | |
+...             | NC ADDR_LOCAL |
+		 | {regind8, lb , tostring(%[1.ind])}         	| |
+...             | NC ADDR_EXTERNAL | | {relative8, %[1.ind]}            | |
+loi             | NC ADDR_LOCAL |
+			remove(all)
+			allocate(REG={CONST2,$1/2},REG)
+			move(lb,%[b])
+			"add $$%(%[1.ind]+$1%),%[b]"
+			"1:\tmov -(%[b]),-(sp)"
+			"sob %[a],1b"
+			erase(%[a]) erase(%[b])		| 		| |
+...             | NC ADDR_EXTERNAL |
+			remove(all)
+			allocate(REG={CONST2,$1/2},REG)
+			"mov $$%[1.ind]+$1,%[b]"
+			"1:\tmov -(%[b]),-(sp)"
+			"sob %[a],1b"
+			erase(%[a]) erase(%[b])		| 		| |
+...		| SCR_REG |
+			remove(all)
+			allocate(REG={CONST2,$1})
+			"add %[a],%[1]"
+			"asr %[a]"
+			"1:\tmov -(%[1]),-(sp)"
+			"sob %[a],1b"
+			erase(%[1]) erase(%[a])         | 		| |
+los $1==2       | |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jsr pc,los2~"                  |       	| |
+los !defined($1)| source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jsr pc,los2~"                  |       	| |
+ldl             | |             | {LOCAL4, $1,4}                        | |
+lde             | |             | {relative4, $1}                       | |
+ldf             | regconst2 |
+		 | {regind4,%[1.reg], tostring($1)+"+"+%[1.ind]}       | |
+...             | NC ADDR_EXTERNAL |
+		 | {relative4, tostring($1)+"+"+%[1.ind]}		| |
+...             | NC ADDR_LOCAL |  | {LOCAL4, %[1.ind]+$1,4}            | |
+lpi             | |             | {ADDR_EXTERNAL, $1}                   | |
+
+/****************************************************************
+ * Group 2 : Store instructions.                                *
+ *                                                              *
+ * These instructions are likely to ruin the fake-stack.        *
+ * We don't expect many items on the fake-stack anyway          *
+ * because we seem to have evaluated an expression just now.    *
+ ****************************************************************/
+
+#ifdef REGVARS
+stl inreg($1)==2| xsource2 |
+			remove(regvar($1))
+			move(%[1],regvar($1))              |       | |
+#endif
+stl             | xsource2 |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			move(%[1],{LOCAL2,$1,2})              |       | |
+ste             | xsource2 |
+			remove(posextern)
+			move(%[1], {relative2, $1 })            |       | |
+#ifdef REGVARS
+sil inreg($1)==2| xsource2 |
+			INDSTORE
+			move(%[1], {regdef2,regvar($1)})          |       | |
+#endif
+sil             | xsource2 |
+			INDSTORE
+			move(%[1], {reginddef2,lb,tostring($1)})          |       | |
+stf             | regconst2 xsource2 |
+			INDSTORE
+			move(%[2],{regind2,%[1.reg],tostring($1)+"+"+%[1.ind]}) |     | |
+...             | ADDR_EXTERNAL xsource2 |
+			INDSTORE
+			move(%[2],{relative2,tostring($1)+"+"+%[1.ind]})|   | |
+#ifdef REGVARS
+lol stf inreg($1)!=2 | xsource2 |
+			INDSTORE
+			allocate(REG={LOCAL2, $1,2})
+			move(%[1],{regind2,%[a],tostring($2)})	|    | |
+sti $1==2       | REG xsource2 |
+			INDSTORE
+			move(%[2],{regdef2,%[1]})               |       | |
+...             | regconst2 xsource2 |
+			INDSTORE
+			move(%[2],{regind2,%[1.reg],%[1.ind]})  |       | |
+...             | ADDR_EXTERNAL xsource2 |
+			INDSTORE
+			move(%[2],{relative2,%[1.ind]})         |       | |
+...		| ADDR_LOCAL xsource2 |
+			INDSTORE
+			move(%[2],{LOCAL2, %[1.ind], 2})	|	| |
+...             | relative2 xsource2 |
+			INDSTORE
+			move(%[2],{reldef2,%[1.ind]})           |       | |
+...             | regind2 xsource2 |
+			INDSTORE
+			move(%[2],{reginddef2,%[1.reg],%[1.ind]}) |     | |
+sti $1==1       | REG source1or2 |
+			INDSTORE
+			move(%[2],{regdef1,%[1]})               |       | |
+...             | NC regconst2 source1or2 |
+			INDSTORE
+			move(%[2],{regind1,%[1.reg],%[1.ind]})  |       | |
+...             | NC ADDR_EXTERNAL source1or2 |
+			INDSTORE
+			move(%[2],{relative1,%[1.ind]})         |       | |
+...		| NC ADDR_LOCAL source1or2 |
+			INDSTORE
+			move(%[2],{regind1, lb, tostring(%[1.ind])}) | | |
+...             | NC relative2 source1or2 |
+			INDSTORE
+			move(%[2],{reldef1,%[1.ind]})           |       | |
+...             | NC regind2 source1or2 |
+			INDSTORE
+			move(%[2],{reginddef1,%[1.reg],%[1.ind]}) |     | |
+sti $1==4       | NC dadres2 FLT_REG |
+			INDSTORE
+			"movfo %[2],*%[1]"
+			samecc                                  |       | |
+...		| NC dadres2 ftolong |
+			INDSTORE
+			"setl\nmovfi %[2.reg],*%[1]\nseti"
+			samecc					|	| |
+...             | NC regconst2 FLT_REG |
+			INDSTORE
+			"movfo %[2],%[1.ind](%[1.reg])"
+			samecc                                  |       | |
+...             | NC regconst2 ftolong |
+			INDSTORE
+			"setl\nmovfi %[2.reg],%[1.ind](%[1.reg])\nseti"
+			samecc                                  |       | |
+...             | NC ADDR_LOCAL FLT_REG |
+			INDSTORE
+			"movfo %[2],%[1.ind](r5)"
+			samecc                                  |       | |
+...             | NC ADDR_LOCAL ftolong |
+			INDSTORE
+			"setl\nmovfi %[2.reg],%[1.ind](r5)\nseti"
+			samecc                                  |       | |
+...		| NC ADDR_EXTERNAL FLT_REG |
+			INDSTORE
+			"movfo %[2],%[1.ind]"
+			samecc					|	| |
+...		| NC ADDR_EXTERNAL ftolong |
+			INDSTORE
+			"setl\nmovfi %[2.reg],%[1.ind]\nseti"
+			samecc					|	| |
+...             | REG source2 source2 |
+			INDSTORE
+			move(%[2],{regdef2,%[1]})
+			move(%[3],{regind2,%[1],"2"})             |       | |
+...             | SCR_REG STACK |
+			"mov (sp)+,(%[1])+"
+			"mov (sp)+,(%[1])"
+			erase(%[1])                             |       | | (4,2040)
+sti $1==8       | NC dadres2 DBL_REG |
+			INDSTORE
+			"movf %[2],*%[1]"
+			samecc                                  |       | |
+...             | NC regconst2 DBL_REG |
+			INDSTORE
+			"movf %[2],%[1.ind](%[1.reg])"
+			samecc                                  |       | |
+...             | NC ADDR_LOCAL DBL_REG |
+			INDSTORE
+			"movf %[2],%[1.ind](r5)"
+			samecc                                  |       | |
+...		| NC ADDR_EXTERNAL DBL_REG |
+			INDSTORE
+			"movf %[2],%[1.ind]"
+			samecc					|	| |
+...		| SCR_REG regind8 |
+			INDSTORE
+			"mov %[2.ind](%[2.reg]),(%[1])+"
+			"mov 2+%[2.ind](%[2.reg]),(%[1])+"
+			"mov 4+%[2.ind](%[2.reg]),(%[1])+"
+			"mov 6+%[2.ind](%[2.reg]),(%[1])"
+			erase(%[1])				|	| |
+...		| SCR_REG relative8 |
+			INDSTORE
+			allocate(REG={ADDR_EXTERNAL,%[2.ind]})
+			"mov (%[a])+,(%[1])+"
+			"mov (%[a])+,(%[1])+"
+			"mov (%[a])+,(%[1])+"
+			"mov (%[a]),(%[1])"
+			erase(%[1]) erase(%[a])			|	| |
+...             | SCR_REG |
+			remove(all)
+			"mov (sp)+,(%[1])+"
+			"mov (sp)+,(%[1])+"
+			"mov (sp)+,(%[1])+"
+			"mov (sp)+,(%[1])"
+			erase(%[1])                             |       | | (8,4080)
+sti             | SCR_REG |
+			remove(all)
+			allocate(REG={CONST2,$1/2})
+			"1:\tmov (sp)+,(%[1])+"
+			"sob %[a],1b"
+			erase(%[1]) erase(%[a]) |       | | (8,1500+$1*825)
+lal sti $2>2 && $2<=8	| NC xsource2 | | %[1] | stl $1 lal $1+2 sti $2-2 |
+...		        | 		        | | {ADDR_LOCAL,$1} | sti $2 |
+sts $1==2       | |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jsr pc,sto2~"
+			erase(r01)                              |       | |
+sdl             | NC FLT_REG |
+			remove(indordef)
+			remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
+			move(%[1],{LOCAL4,$1,4})              |       | |
+...             | NC ftolong |
+			remove(indordef)
+			remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
+			"setl\nmovfi %[1.reg],$1(r5)\nseti"
+			samecc					|       | |
+...             | source2 source2 |
+			remove(indordef)
+			remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
+			move(%[1],{LOCAL2,$1,2})
+			move(%[2],{LOCAL2,$1+2,2})              |       | |
+sde             | NC FLT_REG |
+			remove(posextern)
+			move(%[1],{relative4,$1})               |       | |
+...             | NC ftolong |
+			remove(posextern)
+			"setl\nmovfi %[1.reg],$1\nseti"
+			samecc					|       | |
+...             | source2 source2 |
+			remove(posextern)
+			move(%[1], {relative2, $1 })
+			move(%[2], {relative2, $1+"+2" })            |       | |
+sdf             | NC regconst2 FLT_REG |
+			INDSTORE
+			move(%[2],{regind4,%[1.reg],tostring($1)+"+"+%[1.ind]}) |     | |
+...             | NC regconst2 ftolong |
+			INDSTORE
+			"setl\nmovfi %[2.reg],$1+%[1.ind](%[1.reg])\nseti"
+			samecc					|     | |
+...             | NC ADDR_EXTERNAL FLT_REG |
+			INDSTORE
+			move(%[2],{relative4,tostring($1)+"+"+%[1.ind]})|   | |
+...             | NC ADDR_EXTERNAL ftolong |
+			INDSTORE
+			"setl\nmovfi %[2.reg],$1+%[1.ind]\nseti"
+			samecc					|   | |
+...             | regconst2 source2 source2 |
+			INDSTORE
+			move(%[2],{regind2,%[1.reg],tostring($1)+"+"+%[1.ind]})
+			move(%[3],{regind2,%[1.reg],tostring($1+2)+"+"+%[1.ind]}) |     | |
+...             | ADDR_EXTERNAL source2 source2 |
+			INDSTORE
+			move(%[2],{relative2,tostring($1)+"+"+%[1.ind]})
+			move(%[3],{relative2,tostring($1+2)+"+"+%[1.ind]}) |     | |
+
+/****************************************************************
+ * Group 3 : Integer arithmetic.                                *
+ *                                                              *
+ * Implemented (sometimes with the use of subroutines) :        *
+ * all 2 and 4 byte arithmetic.                         *
+ ****************************************************************/
+
+adi $1==2       | NC SCR_REG CONST2 | | {regconst2,%[1],tostring(%[2.num])} | |
+...		| NC SCR_REG ADDR_EXTERNAL | | {regconst2,%[1],%[2.ind]} | |
+...		| NC SCR_REG ADDR_LOCAL	|
+			"add r5,%[1]" erase(%[1])	|
+					   {regconst2,%[1],tostring(%[2.ind])} | | (2,450)
+...		| NC REG ADDR_LOCAL |
+			allocate(REG)
+			"mov r5,%[a]"
+			"add %[1],%[a]"
+			erase(%[a])	| {regconst2,%[a],tostring(%[2.ind])} | | (4,900)
+...		| NC SCR_REG regconst2 |
+			"add %[2.reg],%[1]" erase(%[1]) |
+					   {regconst2,%[1],%[2.ind]} | | (2,450)
+...		| NC source2-REG CONST2+ADDR_EXTERNAL+ADDR_LOCAL |
+			allocate(%[1],REG=%[1])	| %[2] %[a] | adi 2 |
+...		| NC regconst2 CONST2 | |
+					   {regconst2,%[1.reg],
+					      tostring(%[2.num])+"+"+%[1.ind]} | |
+...		| NC regconst2 ADDR_EXTERNAL | |
+					   {regconst2,%[1.reg],
+					      %[2.ind]+"+"+%[1.ind]} | |
+...		| NC regconst2 ADDR_LOCAL | 
+			"add r5,%[1.reg]" erase(%[1.reg]) |
+					   {regconst2,%[1.reg],
+					      tostring(%[2.ind])+"+"+%[1.ind]} | | (2,450)
+...		| NC regconst2 regconst2 |
+			"add %[2.reg],%[1.reg]" erase(%[1.reg]) |
+					   {regconst2,%[1.reg],%[2.ind]+"+"+%[1.ind]} | | (2,450)
+...		| NC regconst2 noconst2 |
+			"add %[2],%[1.reg]" erase(%[1.reg]) | %[1] | | (2,450)+%[2]
+...		| NC SCR_REG noconst2 |
+			"add %[2],%[1]"
+			setcc(%[1])     erase(%[1])     | %[1]  | | (2,450)+%[2]
+...		| NC source2 regconst2 |
+			"add %[1],%[2.reg]"
+			erase(%[2.reg])			| %[2]	| | (2,450)+%[1]
+...		| NC regconst2 source2 |
+			"add %[2],%[1.reg]"
+			erase(%[1.reg])			| %[1]	| | (2,450)+%[2]
+...             | source2 SCR_REG |
+			"add %[1],%[2]"
+			setcc(%[2])     erase(%[2])     | %[2]  | | (2,450)+%[1]
+adi $1==4       | SCR_REG SCR_REG source2 source2 |
+			"add %[4],%[2]"
+			"adc %[1]"
+			"add %[3],%[1]"
+			setcc(%[1]) erase(%[1]) erase(%[2])
+				| %[2] %[1]              | | (6,1200)+%[4]+%[3]
+...		| SCR_REG SCR_REG source2 STACK |
+			"add (sp)+,%[2]"
+			"adc %[1]"
+			"add %[3],%[1]"
+			setcc(%[1]) erase(%[1]) erase(%[2])
+				| %[2] %[1]              | | (6,1900)+%[3]
+...		| SCR_REG SCR_REG STACK |
+			"add (sp)+,%[1]"
+			"add (sp)+,%[2]"
+			"adc %[1]"
+			setcc(%[1]) erase(%[1]) erase(%[2])
+				| %[2] %[1]		| | (6,2800)
+...             | source2 source2 SCR_REG SCR_REG |
+			"add %[2],%[4]"
+			"adc %[3]"
+			"add %[1],%[3]"
+			setcc(%[3]) erase(%[3]) erase(%[4])
+				| %[4] %[3]              | | (6,1200)+%[1]+%[2]
+adi !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,adi~"                   |       | |
+sbi $1==2       | source2 SCR_REG |
+			"sub %[1],%[2]"
+			setcc(%[2])     erase(%[2])     | %[2]  | | (2,450)+%[1]
+...             | NC SCR_REG source2-REG |
+			"sub %[2],%[1]"
+			"neg %[1]"
+			setcc(%[1])     erase(%[1])     | %[1]  | | (4,750)+%[2]
+sbi $1==4       | source2-REG source2-REG SCR_REG SCR_REG |
+			"sub %[2],%[4]"
+			"sbc %[3]"
+			"sub %[1],%[3]"
+			setcc(%[3]) erase(%[3]) erase(%[4])
+				| %[4] %[3]             | | (6,1200)+%[1]+%[2]
+...		| source2 source2 STACK |
+			"sub %[2],2(sp)"
+			"sbc (sp)"
+			"sub %[1],(sp)"		      | | | (10,2800)+%[1]+%[2]
+sbi !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,sbi~"                   |       | |
+mli $1==2       | SCR_ODD_REG source2 |
+			"mul %[2],%[1]"
+			setcc(%[1])     erase(%[1])     | %[1]  | |(2,3300)+%[2]
+...             | source2 SCR_ODD_REG |
+			"mul %[1],%[2]"
+			setcc(%[2])     erase(%[2])     | %[2]  | |(2,3300)+%[1]
+mli $1==4       | |     remove(all)
+			"jsr pc,mli4~"
+				| r1 r0                                 | |
+mli !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,mli~"                   |       | |
+dvi $1==2       | source2 source2 |
+			allocate(%[2],REG_PAIR)
+			"mov %[2],%[a.2]"
+			"sxt %[a.1]"
+			"div %[1],%[a.1]"		| %[a.1] | |
+...		| source2 source2 |
+			INDSTORE
+			"mov %[1],-(sp)"
+			"mov %[2],r1"
+			"sxt r0"
+			"div (sp)+,r0"			| r0	 | |(100,10000)
+dvi $1==4       | |     remove(all)
+			"jsr pc,dvi4~"                  | r1 r0 | |
+dvi !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,dvi~"                   |       | |
+rmi $1==2       | source2 source2 |
+			allocate(%[2],REG_PAIR)
+			"mov %[2],%[a.2]"
+			"sxt %[a.1]"
+			"div %[1],%[a.1]"		| %[a.2] | |
+...		| source2 source2 |
+			INDSTORE
+			"mov %[1],-(sp)"
+			"mov %[2],r1"
+			"sxt r0"
+			"div (sp)+,r0"			| r1	 | |(100,10000)
+rmi $1==4       | |     remove(all)
+			"jsr pc,rmi4~"                  | r1 r0 | |
+rmi !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,rmi~"                   |       | |
+ngi $1==2       | SCR_REG |
+			"neg %[1]"
+			setcc(%[1])     erase(%[1])     | %[1]  | | (2,750)
+ngi $1==4       | SCR_REG SCR_REG |
+			"neg %[1]"
+			"neg %[2]"
+			"sbc %[1]"
+			setcc(%[1]) erase(%[1]) erase(%[2])
+				| %[2] %[1]                     | | (6,1800)
+ngi !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,ngi~"                   |       | |
+loc sli $1==1 && $2==2 | SCR_REG |
+			"asl %[1]"
+			setcc(%[1])	erase(%[1])		| %[1]| |
+sli $1==2       | source2 SCR_REG |
+			"ash %[1],%[2]"
+			setcc(%[2])     erase(%[2])             | %[2]  | |
+sli $1==4       | source2 SCR_REG_PAIR |
+			"ashc %[1],%[2]"
+			setcc(%[2])     erase(%[2])             | %[2]  | |
+sli !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,sli~"                   |       | |
+loc sri $1==1 && $2==2	| SCR_REG |
+			"asr %[1]"
+			setcc(%[1])	erase(%[1])		| %[1]| |
+loc sri $2==2	| SCR_REG |
+			"ash $$%(0-$1%),%[1]"
+			setcc(%[1])	erase(%[1])		| %[1]| |
+sri $1==2       | SCR_REG SCR_REG |
+			"neg %[1]"
+			"ash %[1], %[2]"
+			setcc(%[2])     erase(%[1]) erase(%[2]) | %[2]  | |
+loc sri $2==4       | SCR_REG_PAIR |
+			"ashc $$%(0-$1%),%[1]"
+			setcc(%[1])     erase(%[1])             | %[1]  | |
+sri $1==4       | SCR_REG SCR_REG_PAIR |
+			"neg %[1]"
+			"ashc %[1],%[2]"
+			setcc(%[2])     erase(%[1]) erase(%[2]) | %[2]  | |
+sri !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,sri~"                   |       | |
+
+/************************************************
+ * Group 4 : unsigned arithmetic                *
+ *                                              *
+ * adu = adi                                    *
+ * sbu = sbi                                    *
+ * slu = sli                                    *
+ *                                              *
+ * Supported : 2- and 4 byte arithmetic.        *
+ ************************************************/
+
+adu             | |     |                                       | adi $1 |
+sbu             | |     |                                       | sbi $1 |
+mlu $1==2       | |     |                                       | mli $1 |
+mlu $1==4       | |     remove(all)
+			"jsr pc,mlu4~"                  | r1 r0 | |
+mlu !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,mlu~"                   |       | |
+dvu $1==2       | |     remove(all)
+			"jsr pc,dvu2~"                  | r0    | |
+dvu $1==4       | |     remove(all)
+			"jsr pc,dvu4~"                  | r1 r0 | |
+dvu !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,dvu~"                   |       | |
+rmu $1==2       | |     remove(all)
+			"jsr pc,rmu2~"                  | r1    | |
+rmu $1==4       | |     remove(all)
+			"jsr pc,rmu4~"                  | r1 r0 | |
+rmu !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,rmu~"                   |       | |
+slu 		| |	|				| sli $1 |
+sru $1==2       | SCR_REG xsource2 |
+			allocate(%[2],REG_PAIR)
+			move(%[2],%[a.2])
+			move({CONST2,0},%[a.1])
+			"neg %[1]"
+			"ashc %[1],%[a]"
+			erase(%[a])			| %[a.2]  | |
+loc sru $2==2       | xsource2 |
+			allocate(%[1],REG_PAIR)
+			move(%[1],%[a.2])
+			move({CONST2,0},%[a.1])
+			"ashc $$%(0-$1%),%[a]"
+			erase(%[a])			| %[a.2]  | |
+sru $1==4       | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,sru~"
+			erase(r0)                               |       | |
+sru !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,sru~"                   |       | |
+
+/************************************************
+ * Group 5 : Floating point arithmetic          *
+ *                                              *
+ * Supported : 4- and 8 byte arithmetic.        *
+ ************************************************/
+
+adf $1==4       | FLT_REG SCR_FLT_REG |
+			"addf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,5000)+%[1]
+...             | SCR_FLT_REG FLT_REG |
+			"addf %[2],%[1]"
+			samecc erase(%[1])              | %[1] | | (2,5000)+%[2]
+adf $1==8       | double8 SCR_DBL_REG |
+			"addf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,6000)+%[1]
+...             | SCR_DBL_REG double8 |
+			"addf %[2],%[1]"
+			samecc erase(%[1])              | %[1] | | (2,6000)+%[2]
+adf !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,adf~"                   |       | |
+sbf $1==4       | FLT_REG SCR_FLT_REG |
+			"subf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,5000)+%[1]
+sbf $1==8       | double8 SCR_DBL_REG |
+			"subf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,6000)+%[1]
+sbf !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,sbf~"                   |       | |
+mlf $1==4       | FLT_REG SCR_FLT_REG |
+			"mulf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,7000)+%[1]
+...             | SCR_FLT_REG FLT_REG |
+			"mulf %[2],%[1]"
+			samecc erase(%[1])              | %[1] | | (2,7000)+%[2]
+mlf $1==8       | double8 SCR_DBL_REG |
+			"mulf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,10000)+%[1]
+...             | SCR_DBL_REG double8 |
+			"mulf %[2],%[1]"
+			samecc erase(%[1])              | %[1] | | (2,10000)+%[2]
+mlf !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,mlf~"                   |       | |
+dvf $1==4       | FLT_REG SCR_FLT_REG |
+			"divf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,8000)+%[1]
+dvf $1==8       | double8 SCR_DBL_REG |
+			"divf %[1],%[2]"
+			samecc erase(%[2])              | %[2] | | (2,12000)+%[1]
+dvf !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,dvf~"                   |       | |
+ngf $1==4       | SCR_FLT_REG |
+			"negf %[1]"
+			samecc erase(%[1])              | %[1] | |(2,2700)
+ngf $1==8       | SCR_DBL_REG |
+			"negf %[1]"
+			samecc erase(%[1])              | %[1] | |(2,2700)
+ngf !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,ngf~"                   |       | |
+fif $1==4       | longf4 FLT_REG |
+			allocate(FLT_REG_PAIR)
+			move(%[1],%[a.1])
+			"modf %[2],%[a]"
+			samecc erase(%[a.1])    | %[a.1] %[a.2] | | (2,7500)+%[2]
+fif $1==8       | double8 double8 |
+			allocate(DBL_REG_PAIR)
+			move(%[1],%[a.1])
+			"modf %[2],%[a]"
+			samecc erase(%[a.1])    | %[a.1] %[a.2] | | (2,15000)+%[2]
+fif !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,fif~"                   |       | |
+fef $1==4       | FLT_REG |
+			allocate(REG)
+			"movei %[1],%[a]"
+			"movie $$0,%[1]"
+			samecc
+			erase(%[1])             |%[1] %[a] | | (4,5000)
+fef $1==8       | DBL_REG |
+			allocate(REG)
+			"movei %[1],%[a]"
+			"movie $$0,%[1]"
+			samecc
+			erase(%[1])             |%[1] %[a] | | (4,5000)
+fef !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,fef~"                   |       | |
+
+/****************************************
+ * Group 6 : pointer arithmetic.        *
+ *                                      *
+ * Pointers have size 2 bytes.          *
+ ****************************************/
+
+adp		| SCR_REG |  | {regconst2, %[1], tostring($1)} | |
+...             | NC regconst2 |   | {regconst2, %[1.reg], tostring($1)+"+"+%[1.ind]}    | |
+...             | NC ADDR_EXTERNAL | | {ADDR_EXTERNAL, tostring($1)+"+"+%[1.ind]} | |
+...             | NC ADDR_LOCAL |  | {ADDR_LOCAL,%[1.ind]+$1}              | |
+ads $1==2       | |             |                       | adi $1 |
+sbs $1==2       | |             |                       | sbi $1 |
+
+/****************************************
+ * Group 7 : increment/decrement/zero   *
+ ****************************************/
+
+inc             | SCR_REG |
+			"inc %[1]"
+			setcc(%[1])     erase(%[1])     | %[1] | |
+#ifdef REGVARS
+inl inreg($1)==2| |     remove(regvar($1))
+			"inc %(regvar($1)%)"
+			erase(regvar($1))          |       | |
+#endif
+inl             | |     remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"inc $1(r5)"
+			setcc({LOCAL2,$1,2})          |       | |
+ine             | |     remove(posextern)
+			"inc $1"
+			setcc({relative2,$1})           |       | |
+dec             | SCR_REG |
+			"dec %[1]"
+			setcc(%[1])     erase(%[1])     | %[1]  | |
+#ifdef REGVARS
+del inreg($1)==2| |     remove(regvar($1))
+			"dec %(regvar($1)%)"
+			erase(regvar($1))          |       | |
+#endif
+del             | |     remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"dec $1(r5)"
+			setcc({LOCAL2,$1,2})          |       | |
+dee             | |     remove(posextern)
+			"dec $1"
+			setcc({relative2,$1})           |       | | (4,900)
+
+#ifdef REGVARS
+lol loc sbi stl $1==$4 && $3==2 && inreg($1)==2 | | 
+			remove(regvar($1))
+			"sub $$$2,%(regvar($1)%)"
+			erase(regvar($1))		|	| |
+lol ngi stl $1==$3 && $2==2 && inreg($1)==2 | |
+			remove(regvar($1))
+			"neg %(regvar($1)%)"
+			erase(regvar($1))		|	| |
+lil ngi sil $1==$3 && $2==2 && inreg($1)==2 | |
+			INDSTORE
+			"neg *%(regvar($1)%)" 		|	| |
+lil inc sil $1==$3 && inreg($1)==2 | | INDSTORE
+			"inc *%(regvar($1)%)"		|	| |
+lol adi stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
+			remove(regvar($1))
+			"add %[1],%(regvar($1)%)"
+			erase(regvar($1))		|	| |
+lol adp stl $1==$3 && $2==1 && inreg($1)==2 | |
+			remove(regvar($1))
+			"inc %(regvar($1)%)"
+			erase(regvar($1))		|	| |
+lol adp stl $1==$3 && inreg($1)==2 | |
+			remove(regvar($1))
+			"add $$$2,%(regvar($1)%)"
+			erase(regvar($1))		|	| |
+#endif
+lol loc sbi stl $1==$4 && $3==2 | | 
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"sub $$$2,$1(r5)"
+			setcc({LOCAL2,$1,2})		|	| |
+lol ngi stl $1==$3 && $2==2 | |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"neg $1(r5)"
+			setcc({LOCAL2,$1,2})		|	| |
+lil ngi sil $1==$3 && $2==2 | | INDSTORE
+			"neg *$1(r5)"			|	| |
+lil inc sil $1==$3 | | INDSTORE
+			"inc *$1(r5)"			|	| |
+lol adi stl $2==2 && $1==$3 | source2 |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"add %[1],$1(r5)"
+			setcc({LOCAL2,$1,2})		|	| |
+lol adp stl $1==$3 && $2==1 | |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"inc $1(r5)"
+			setcc({LOCAL2,$1,2})		|	| |
+lol adp stl $1==$3 | |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"add $$$2,$1(r5)"
+			setcc({LOCAL2,$1,2})		|	| |
+loe adi ste $2==2 && $1==$3 | source2 |
+			remove(posextern)
+			"add %[1],$1"
+			setcc({relative2,$1})		|	| |
+loe adp ste $1==$3 | |
+			remove(posextern)
+			"add $$$2,$1"
+			setcc({relative2,$1})		|	| |
+#ifdef REGVARS
+lol ior stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
+			remove(regvar($1))
+			"bis %[1],%(regvar($1)%)"
+			erase(regvar($1))		|	| |
+#endif
+lol ior stl $2==2 && $1==$3 | source2 |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"bis %[1],$1(r5)"
+			setcc({LOCAL2,$1,2})		|	| |
+loe ior ste $2==2 && $1==$3 | source2 |
+			remove(posextern)
+			"bis %[1],$1"
+			setcc({relative2,$1})		|	| |
+#ifdef REGVARS
+lol and stl $2==2 && $1==$3 && inreg($1)==2 | SCR_REG |
+			remove(regvar($1))
+			"com %[1]"
+			"bic %[1],%(regvar($1)%)"
+			erase(%[1])
+			erase(regvar($1))		|	| |
+#endif
+lol and stl $2==2 && $1==$3 | SCR_REG |
+			remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"com %[1]"
+			"bic %[1],$1(r5)"
+			erase(%[1])
+			setcc({LOCAL2,$1,2})		|	| |
+loe and ste $2==2 && $1==$3 | SCR_REG |
+			remove(posextern)
+			"com %[1]"
+			"bic %[1],$1"
+			erase(%[1])
+			setcc({relative2,$1})		|	| |
+#ifdef REGVARS
+loc lol and stl $3==2 && $2==$4 && inreg($2)==2 | |
+			remove(regvar($2))
+			"bic $$%(~$1%),%(regvar($2)%)"
+			erase(regvar($2))		|	| |
+#endif
+loc lol and stl $3==2 && $2==$4 | |
+			remove(indordef)
+			remove(locals, %[ind] <= $2 && %[ind]+%[size] > $2)
+			"bic $$%(~$1%),$2(r5)"
+			setcc({LOCAL2,$2,2})		|	| |
+loc loe and ste $3==2 && $2==$4 | |
+			remove(posextern)
+			"bic $$%(~$1%),$2"
+			setcc({relative2,$2})		|	| |
+#ifdef REGVARS
+zrl inreg($1)==2| |     remove(regvar($1))
+			"clr %(regvar($1)%)"
+			erase(regvar($1))          |       | | (4,900)
+#endif
+zrl             | |     remove(indordef)
+			remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
+			"clr $1(r5)"
+			setcc({LOCAL2,$1,2})          |       | | (4,900)
+zre             | |     remove(posextern)
+			"clr $1"
+			setcc({relative2,$1})           |       | | (4,900)
+zrf $1==4       | |     allocate(FLT_REG)
+			"clrf %[a]"             | %[a]  | | (2,2200)
+zrf $1==8       | |     allocate(DBL_REG)
+			"clrf %[a]"             | %[a]  | | (2,2400)
+zrf !defined($1)| |             |                       | zer |
+zrf defined($1) | |             |                       | zer $1 |
+zer $1==2       | |             | {CONST2, 0}                   | |
+zer $1==4       | |             | {CONST2,0}     {CONST2,0}     | |
+zer $1==6       | |             | {CONST2,0} {CONST2,0}
+				  {CONST2,0}                    | |
+zer $1==8       | |             | {CONST2,0} {CONST2,0}
+				  {CONST2, 0} {CONST2,0}        | |
+zer defined($1) | |     remove(all)
+			move({CONST2,$1/2},r0)
+			"1:\tclr -(sp)"
+			"sob r0,1b"
+			erase(r0)                       |       | |(8,1500+$1*375)
+zer !defined($1)| SCR_REG |
+			remove(all)
+			"asr %[1]"
+			"1:\tclr -(sp)"
+			"sob %[1],1b"
+			erase(%[1])                             |       | |
+
+/****************************************
+ * Group 8 : Convert instructions       *
+ ****************************************/
+
+cii             | |     remove(all)
+			" jsr pc,cii~"                  |       | |
+cfi             | |             |                       | cfu   |
+cfu             | |     remove(ALL)
+			"jsr pc,cfi~"                   |       | |
+cif             | |     remove(ALL)
+			"jsr pc,cif~"                   |       | |
+cuf             | |     remove(ALL)
+			"jsr pc,cuf~"                   |       | |
+cff             | |     remove(ALL)
+			"jsr pc,cff~"                   |       | |
+ciu             | |             |                       | cuu   |
+cui             | |             |                       | cuu   |
+cuu             | |     remove(all)
+			"jsr pc,cuu~"                   |       | |
+loc loc cii $1==1 && $2==2      | source1or2 |
+			 allocate(%[1],REG)
+			 "movb %[1],%[a]"
+			 /* movb does sign extend if dest is register */
+			                                        | %[a]  | |
+loc loc cii $1==1 && $2==4      | source1or2 |
+			allocate(%[1],REG,REG)
+			"movb %[1],%[a]"
+			"sxt %[b]"
+			                                        | %[a] %[b] | |
+loc loc cii $1==2 && $2==4      | source2 |
+			allocate(%[1],REG,REG)
+			move(%[1],%[a])
+			test(%[a])
+			"sxt %[b]"
+			                                        | %[a] %[b] | |
+loc loc loc cii $1>=0 && $2==2 && $3==4	| | | | loc $1 loc 0 |
+loc loc loc cii $1< 0 && $2==2 && $3==4	| | | | loc $1 loc 0-1 |
+loc loc cii $1==4 && $2==2      | source2 source2 |             | %[2]  | |
+loc loc cuu $1==2 && $2==4      | | | {CONST2,0} | |
+loc loc cuu $1==4 && $2==2      | source2 |             |   | |
+loc loc cfi     | |             |               | loc $1 loc $2 cfu     |
+loc loc cfu $1==4 && $2==2      | FLT_REG |     | {ftoint,%[1]} | |
+loc loc cfu $1==4 && $2==4      | FLT_REG |     | {ftolong,%[1]} | |
+loc loc cfu $1==8 && $2==2      | DBL_REG |     | {ftoint,%[1]} | |
+loc loc cfu $1==8 && $2==4      | DBL_REG |     | {ftolong,%[1]} | |
+loc loc cif $1==2 && $2==4      | source2 |
+			allocate(FLT_REG)
+			"movif %[1],%[a]"
+			samecc
+			                                        | %[a]  | |
+loc loc cif $1==2 && $2==8      | source2 |
+			allocate(DBL_REG)
+			"movif %[1],%[a]"
+			samecc
+			                                        | %[a]  | |
+loc loc cif $1==4 && $2==4      | NC long4-REG_PAIR |
+			allocate(FLT_REG)
+			"setl"
+			"movif %[1],%[a]"
+			"seti"
+			samecc
+			                                        | %[a]  | |
+...     | |             remove(all)
+			allocate(FLT_REG)
+			"setl"
+			"movif (sp)+,%[a]"
+			"seti"
+			samecc
+			                                        | %[a]  | |
+loc loc cif $1==4 && $2==8      | NC long4-REG_PAIR |
+			allocate(DBL_REG)
+			"setl"
+			"movif %[1],%[a]"
+			"seti"
+			samecc
+			                                        | %[a]  | |
+...     | |             remove(all)
+			allocate(DBL_REG)
+			"setl"
+			"movif (sp)+,%[a]"
+			"seti"
+			samecc
+			                                        | %[a]  | |
+loc loc cuf $1==2 && $2==4      | |
+			remove(all)
+			allocate(FLT_REG)
+			"clr -(sp)"
+			"setl"
+			"movif (sp)+,%[a]"
+			"seti"
+			                                        | %[a]  | |
+loc loc cuf $1==2 && $2==8      | |
+			remove(all)
+			allocate(DBL_REG)
+			"clr -(sp)"
+			"setl"
+			"movif (sp)+,%[a]"
+			"seti"
+			                                        | %[a]  | |
+loc loc cuf $1==4 && ($2==8 || $2==4) | |       | | loc $1 loc $2 cif |
+loc loc cff $1==4 && $2==8      | longf4 - FLT_REG |
+			allocate(DBL_REG)
+			"movof %[1],%[a]"
+			samecc
+			                                        | %[a]  | |
+...				| FLT_REG |
+			allocate(DBL_REG)
+			move(%[1],%[a.1])
+			samecc					| %[a] | |
+loc loc cff $1==8 && $2==4      | DBL_REG |			| %[1.1] | |
+
+/****************************************
+ * Group 9 : Logical instructions       *
+ ****************************************/
+
+and $1==2 	| CONST2 SCR_REG |
+			"bic $$%(~%[1.num]%),%[2]"
+			setcc(%[2])
+			erase(%[2])		| %[2]  | | (4,750)
+...		| SCR_REG CONST2 |
+			"bic $$%(~%[2.num]%),%[1]"
+			setcc(%[1])
+			erase(%[1])		| %[1]	| | (4,750)
+...		| SCR_REG SCR_REG |
+			"com %[1]"
+			"bic %[1],%[2]"
+			setcc(%[2])
+			erase(%[1]) erase(%[2]) | %[2]  | | (4,600)
+and defined($1) | |     remove(all)
+			move({CONST2,$1}, r0)
+			"jsr pc,and~"
+			erase(r0)                               |       | |
+and !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,and~"
+			erase(r0)                               |       | |
+ior $1==2       | SCR_REG source2 |
+			"bis %[2],%[1]"
+			setcc(%[1])
+			erase(%[1])                     | %[1]  | | (2,450)+%[2]
+...             | source2 SCR_REG |
+			"bis %[1],%[2]"
+			setcc(%[2])
+			erase(%[2])                     | %[2]  | | (2,450)+%[1]
+ior $1==8	| NC source2 source2 source2 source2 |
+			remove(all)
+			"bis %[1],(sp)"
+			"bis %[2],2(sp)"
+			"bis %[3],4(sp)"
+			"bis %[4],6(sp)"		|	| |
+...		| |	remove(all)
+			allocate(REG={CONST2,$1})
+			"add sp,%[a]"
+			"bis (sp)+,(%[a])+"
+			"bis (sp)+,(%[a])+"
+			"bis (sp)+,(%[a])+"
+			"bis (sp)+,(%[a])+"
+			erase(%[a])			|	| |
+ior defined($1) | |     remove(all)
+			allocate(REG={CONST2,$1},REG={CONST2,$1/2})
+			"add sp,%[a]"
+			"1:\tbis (sp)+,(%[a])+"
+			"sob %[b],1b"
+			erase(%[a]) erase(%[b])		|       | | (12,2100+$1*975)
+ior !defined($1)| SCR_REG |
+			remove(all)
+			allocate(REG=%[1])
+			"asr %[1]"
+			"add sp,%[a]"
+			"1:\tbis (sp)+,(%[a])+"
+			"sob %[1],1b"
+			erase(%[1]) erase(%[a])         |       | |
+xor $1==2       | REG SCR_REG |
+			"xor %[1],%[2]"
+			setcc(%[2])
+			erase(%[2])                     | %[2]  | | (2,300)
+...             | SCR_REG REG |
+			"xor %[2],%[1]"
+			setcc(%[1])
+			erase(%[1])                     | %[1]  | | (2,300)
+xor defined($1) | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,xor~"
+			erase(r0)                               |       | |
+xor !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,xor~"
+			erase(r0)                               |       | |
+com $1==2       | SCR_REG |
+			"com %[1]"
+			setcc(%[1])
+			erase(%[1])                     | %[1]  | | (2,300)
+com defined($1) | |     remove(all)
+			allocate(REG={CONST2,$1/2},REG)
+			"mov sp,%[b]"
+			"1:\tcom (%[b])+"
+			"sob %[a],1b"
+			erase(%[a])                     |       | | (10,1800+$1*825)
+com !defined($1)| SCR_REG |
+			remove(all)
+			allocate(REG)
+			"asr %[1]"
+			"mov sp,%[a]"
+			"1:\tcom (%[a])+"
+			"sob %[1],1b"
+			erase(%[1])                             |       | |
+rol $1==2       | CONST2 SCR_ODD_REG |
+			"ashc $$%(%[1.num]-16%),%[2]"
+			setcc(%[2])
+			erase(%[2])			| %[2] | |
+...		| SCR_REG SCR_ODD_REG |
+			"sub $$16,%[1]"
+			"ashc %[1],%[2]"
+			setcc(%[2])
+			erase(%[1]) erase(%[2])         | %[2]  | |
+rol defined($1) | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,rol~"
+			erase(r0)                               |       | |
+rol !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,rol~"
+			erase(r0)                               |       | |
+ror $1==2       | CONST2 SCR_ODD_REG |
+			"ashc $$%(0-%[1.num]%),%[2]"
+			setcc(%[2])
+			erase(%[2])			| %[2]	| |
+...		| SCR_REG SCR_ODD_REG |
+			"neg %[1]"
+			"ashc %[1],%[2]"
+			setcc(%[2]) erase(%[1]) erase(%[2])     | %[2]  | |
+ror defined($1) | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,ror~"
+			erase(r0)                               |       | |
+ror !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,ror~"
+			erase(r0)                               |       | |
+com and $1==2 && $2==2  | source2 SCR_REG |
+			  "bic %[1],%[2]"
+			  setcc(%[2])
+			  erase(%[2])                   | %[2]  | | (2,450)+%[1]
+com and $1==$2  | |     remove(all)
+			allocate(REG={CONST2,$1},REG)
+			"mov sp,%[b]"
+			"add %[a],%[b]"
+			"asr %[a]"
+			"1:\tbic (sp)+,(%[b])+"
+			"sob %[a],1b"
+			erase(%[a])                     |       | | (12,2100+$1*975)
+
+/********************************
+ * Group 10 : Set instructions  *
+ ********************************/
+
+inn $1==2       | SCR_REG SCR_REG |
+			"neg %[1]"
+			"ash %[1],%[2]"
+			"bic $$177776,%[2]"
+			erase(%[1]) erase(%[2])                 | %[2]  | |
+loc inn $2==2 && $1==0 | SCR_REG |
+			"bic $$177776,%[1]"
+			erase(%[1])				| %[1]	| |
+loc inn $2==2 && $1==1 | SCR_REG |
+			"asr %[1]"
+			"bic $$177776,%[1]"
+			erase(%[1])				| %[1]	| |
+loc inn $2==2	| SCR_REG |
+			"ash $$%(0-$1%),%[1]"
+			"bic $$177776,%[1]"
+			erase(%[1])				| %[1]	| |
+
+loc inn zeq $2==2 | |	| {CONST2, 1<<$1} | and 2 zeq $3 |
+inn zeq $1==2	| source2 |
+			allocate(REG={CONST2,1})
+			"ash %[1],%[a]"			| %[a] | and 2 zeq $2 |
+loc inn zne $2==2 | |	| {CONST2, 1<<$1} | and 2 zne $3 |
+inn zne $1==2	| source2 |
+			allocate(REG={CONST2,1})
+			"ash %[1],%[a]"			| %[a] | and 2 zne $2 |
+inn defined($1) | source2 |
+			remove(all)
+			move(%[1],r1)
+			move({CONST2,$1},r0)
+			"jsr pc,inn~"
+			erase(r01)                              | r0    | |
+inn !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"mov (sp)+,r1"
+			"jsr pc,inn~"
+			erase(r01)                              | r0    | |
+set $1==2       | REG |
+			allocate(REG={CONST2,1})
+			"ash %[1],%[a]"
+			erase(%[a])                             | %[a]  | |
+set defined($1) | source2 |
+			remove(all)
+			move(%[1],r1)
+			move({CONST2,$1},r0)
+			"jsr pc,set~"
+			erase(r01)                              |       | |
+set !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"mov (sp)+,r1"
+			"jsr pc,set~"
+			erase(r01)                              |       | |
+
+/****************************************
+ * Group 11 : Array instructions        *
+ ****************************************/
+
+lae aar $2==2 && rom(1,3)==1 && rom(1,1)==0 | | | | adi 2 |
+lae aar $2==2 && rom(1,3)==1 && rom(1,1)!=0 | | | | adi 2 adp 0-rom(1,1) |
+
+lae aar $2==2 && rom(1,3)==2 && rom(1,1)==0 | SCR_REG |
+			"asl %[1]"
+			erase(%[1])        | %[1] | adi 2 |
+lae aar $2==2 && rom(1,3)==2 && rom(1,1)!=0 | SCR_REG |
+			"asl %[1]"
+			erase(%[1])                             |
+					{regconst2,%[1],tostring((0-2)*rom(1,1))}  | 
+					adi 2 |
+lae aar $2==2 && rom(1,3)==4 && rom(1,1)==0 | SCR_REG |
+			"ash $$2,%[1]"
+			erase(%[1])                             | 
+					%[1]  |
+					adi 2 |
+lae aar $2==2 && rom(1,3)==4 && rom(1,1)!=0 | SCR_REG |
+			"ash $$2,%[1]"
+			erase(%[1])                             | 
+					{regconst2,%[1],tostring((0-4)*rom(1,1))}  |
+					adi 2 |
+lae aar $2==2 && rom(1,3)==8 && rom(1,1)==0 | SCR_REG |
+			"ash $$3,%[1]"
+			erase(%[1])                             | 
+					%[1]  |
+					adi 2 |
+lae aar $2==2 && rom(1,3)==8 && rom(1,1)!=0 | SCR_REG |
+			"ash $$3,%[1]"
+			erase(%[1])                             | 
+					{regconst2,%[1],tostring((0-8)*rom(1,1))}  |
+					adi 2 |
+lae aar $2==2 && rom(1,1)==0 | SCR_ODD_REG |
+			"mul $$%(rom(1,3)%),%[1]"
+			erase(%[1])                             | 
+					%[1]  |
+					adi 2 |
+lae aar $2==2 && defined(rom(1,1)) | SCR_ODD_REG |
+			"mul $$%(rom(1,3)%),%[1]"
+			erase(%[1])                             | 
+					{regconst2,%[1],tostring((0-rom(1,3))*rom(1,1))}  |
+					adi 2 |
+aar $1==2       | |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jsr pc,aar~"
+			erase(r01)                              |       | |
+aar !defined($1) | |    remove(all)
+			"jsr pc,iaar~"                  |       | |
+lae sar defined(rom(1,3)) | |   |       | lae $1 aar $2 sti rom(1,3) |
+lae lar defined(rom(1,3)) | |   |       | lae $1 aar $2 loi rom(1,3) |
+sar $1==2       | |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jsr pc,sar~"
+			erase(r01)                              |       | |
+sar !defined($1) | |    remove(all)
+			"jsr pc,isar~"                  |       | |
+lar $1==2       | |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jsr pc,lar~"
+			erase(r01)                              |       | |
+lar !defined($1) | |    remove(all)
+			"jsr pc,ilar~"                  |       | |
+
+/****************************************
+ * group 12 : Compare instructions      *
+ ****************************************/
+
+cmi $1==2       | source2 SCR_REG |
+			"sub %[1],%[2]"
+			setcc(%[2])
+			erase(%[2])                             | %[2]  | |
+...             | SCR_REG source2 |
+			"sub %[2],%[1]"
+			"neg %[1]"
+			setcc(%[1])
+			erase(%[1])                             | %[1]  | |
+cmi $1==4       | |     remove(all)
+			"jsr pc,cmi4~"                  | r0    | |
+cmi !defined($1) | source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,cmi~"
+			erase(r0)                               | r0    | |
+cmf defined($1) | |     remove(ALL)
+			move({CONST2,$1},r0)
+			"jsr pc,cmf~"
+			erase(r0)                               | r0    | |
+cmf !defined($1)| source2 |
+			remove(ALL)
+			move(%[1],r0)
+			"jsr pc,cmf~"
+			erase(r0)                               | r0    | |
+cmu $1==2       | |             |                       | cmp |
+cmu $1==4       | |     remove(all)
+			"jsr pc,cmu4~"                  | r0    | |
+cmu defined($1) | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,cmu~"                   | r0    | |
+cmu !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,cmu~"
+			erase(r0)                               | r0    | |
+cms $1==2       | |             |                       | cmi $1 |
+cms defined($1) | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,cms~"
+			erase(r0)                               | r0    | |
+cms !defined($1)| source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,cms~"
+			erase(r0)                              | r0    | |
+cmp             | source2 source2 |
+			allocate(REG = {CONST2,0})
+			"cmp %[1],%[2]"
+			"beq 2f"
+			"bhi 1f"
+			"inc %[a]"
+			"br 2f"
+			"1:\tdec %[a]\n2:"
+			setcc(%[a])
+			erase(%[a])                             | %[a]  | |
+tlt and $2==2	| source2 SCR_REG |
+			test(%[1])
+			"blt 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+tlt ior $2==2	| source2 SCR_REG |
+			test(%[1])
+			"bge 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+tlt             | source2 |
+			allocate(REG={CONST2,0})
+			test(%[1])
+			"bge 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+tle and $2==2	| source2 SCR_REG |
+			test(%[1])
+			"ble 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+tle ior $2==2	| source2 SCR_REG |
+			test(%[1])
+			"bgt 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+tle             | source2 |
+			allocate(REG={CONST2,0})
+			test(%[1])
+			"bgt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+teq and $2==2	| source1or2 SCR_REG |
+			test(%[1])
+			"beq 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+teq ior $2==2	| source1or2 SCR_REG |
+			test(%[1])
+			"bne 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+teq             | source1or2 |
+			allocate(REG={CONST2,0})
+			test(%[1])
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+tne and $2==2	| source1or2 SCR_REG |
+			test(%[1])
+			"bne 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+tne ior $2==2	| source1or2 SCR_REG |
+			test(%[1])
+			"beq 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+tne             | source1or2 |
+			allocate(REG={CONST2,0})
+			test(%[1])
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+tgt and $2==2	| source2 SCR_REG |
+			test(%[1])
+			"bgt 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+tgt ior $2==2	| source2 SCR_REG |
+			test(%[1])
+			"ble 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+tgt             | source2 |
+			allocate(REG={CONST2,0})
+			test(%[1])
+			"ble 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+tge and $2==2	| source2 SCR_REG |
+			test(%[1])
+			"bge 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+tge ior $2==2	| source2 SCR_REG |
+			test(%[1])
+			"blt 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+tge             | source2 |
+			allocate(REG={CONST2,0})
+			test(%[1])
+			"blt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+and tne $1==2       | source2 source2 |
+			allocate(REG={CONST2,0})
+			"bit %[1],%[2]"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+and teq $1==2       | source2 source2 |
+			allocate(REG={CONST2,0})
+			"bit %[1],%[2]"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+
+cmi tlt and $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"blt 1f"
+			"clr %[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tlt ior $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"bge 1f"
+			"bis $$1,%[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tlt $1==2   | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"bge 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmi tle and $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"ble 1f"
+			"clr %[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tle ior $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"bgt 1f"
+			"bis $$1,%[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tle $1==2   | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"bgt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmi teq and $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"beq 1f"
+			"clr %[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi teq ior $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"bne 1f"
+			"bis $$1,%[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi teq $1==2   | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+loc cmi teq and $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
+			"cmpb %[1],$$$1"
+			"beq 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+...	| |		| {CONST2, $1}	| cmi 2 teq and 2 |
+loc cmi teq ior $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
+			"cmpb %[1],$$$1"
+			"bne 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+...	| |		| {CONST2, $1}	| cmi 2 teq ior 2 |
+loc cmi teq $1>=0 && $1<=127 && $2==2   | NC source1 |
+			allocate(REG={CONST2,0})
+			"cmpb %[1],$$$1"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+...	| |		| {CONST2, $1}	| cmi 2 teq  |
+cmi tne and $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"bne 1f"
+			"clr %[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tne ior $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"beq 1f"
+			"bis $$1,%[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tne $1==2   | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+loc cmi tne and $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
+			"cmpb %[1],$$$1"
+			"bne 1f"
+			"clr %[2]\n1:"
+			erase(%[2])				| %[2] | |
+...	| |		| {CONST2, $1}	| cmi 2 tne and 2 |
+loc cmi tne ior $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
+			"cmpb %[1],$$$1"
+			"beq 1f"
+			"bis $$1,%[2]\n1:"
+			erase(%[2])				| %[2] | |
+...	| |		| {CONST2, $1}	| cmi 2 tne ior 2 |
+loc cmi tne $1>=0 && $1<=127 && $2==2   | NC source1 |
+			allocate(REG={CONST2,0})
+			"cmpb %[1],$$$1"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+...	| |		| {CONST2, $1}	| cmi 2 tne  |
+cmi tge and $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"bge 1f"
+			"clr %[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tge ior $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"blt 1f"
+			"bis $$1,%[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tge $1==2   | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"blt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmi tgt and $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"bgt 1f"
+			"clr %[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tgt ior $1==2 && $3==2 | source2 source2 SCR_REG |
+			"cmp %[2],%[1]"
+			"ble 1f"
+			"bis $$1,%[3]\n1:"
+			erase(%[3])				| %[3] | |
+cmi tgt $1==2   | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"ble 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmp tlt | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"bhis 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmp tle | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"bhi 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmp teq | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmp tne | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmp tge | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"blo 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmp tgt | source2 source2 |
+			allocate(REG={CONST2,0})
+			"cmp %[2],%[1]"
+			"blos 1f"
+			"inc %[a]\n1:"
+			erase(%[a])                             | %[a]  | |
+cmf tlt $1==4	| FLT_REG FLT_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"bge 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tle $1==4	| FLT_REG FLT_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"bgt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf teq $1==4	| FLT_REG FLT_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tne $1==4	| FLT_REG FLT_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tgt $1==4	| FLT_REG FLT_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"ble 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tge $1==4	| FLT_REG FLT_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"blt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tlt $1==8	| DBL_REG double8 |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"bge 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+...		| double8 DBL_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[1],%[2]\ncfcc"
+			"ble 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tle $1==8	| DBL_REG double8 |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"bgt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+...		| double8 DBL_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[1],%[2]\ncfcc"
+			"blt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf teq $1==8	| DBL_REG double8 |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+...		| double8 DBL_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[1],%[2]\ncfcc"
+			"bne 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tne $1==8	| DBL_REG double8 |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+...		| double8 DBL_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[1],%[2]\ncfcc"
+			"beq 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tgt $1==8	| DBL_REG double8 |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"ble 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+...		| double8 DBL_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[1],%[2]\ncfcc"
+			"bge 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+cmf tge $1==8	| DBL_REG double8 |
+			allocate(REG={CONST2,0})
+			"cmpf %[2],%[1]\ncfcc"
+			"blt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+...		| double8 DBL_REG |
+			allocate(REG={CONST2,0})
+			"cmpf %[1],%[2]\ncfcc"
+			"bgt 1f"
+			"inc %[a]\n1:"
+			erase(%[a])				| %[a] | |
+
+/****************************************
+ * Group 13 : Branch instructions       *
+ ****************************************/
+
+bra             | |     remove(all)
+			"jbr $1"
+			samecc                                  |       | |
+blt             | source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jlt $1"                                |       | |
+ble             | source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jle $1"                                |       | |
+beq             | source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jeq $1"                                |       | |
+bne             | source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jne $1"                                |       | |
+bge             | source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jge $1"                                |       | |
+bgt             | source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jgt $1"                                |       | |
+loc beq $1>=0 && $1<=127 | NC source1 |
+			remove(all)
+			"cmpb %[1],$$$1"
+			"jeq $2"				|	| |
+...		| |			| {CONST2, $1}		| beq $2 |
+loc bne $1>=0 && $1<=127 | NC source1 |
+			remove(all)
+			"cmpb %[1],$$$1"
+			"jne $2"				|	| |
+...		| |			| {CONST2, $1}		| bne $2 |
+zlt             | source2 |
+			remove(all)
+			test(%[1])
+			"jlt $1"
+			samecc                                  |       | |
+zle             | source2 |
+			remove(all)
+			test(%[1])
+			"jle $1"
+			samecc                                  |       | |
+zeq             | source1or2 |
+			remove(all)
+			test(%[1])
+			"jeq $1"
+			samecc                                  |       | |
+zne             | source1or2 |
+			remove(all)
+			test(%[1])
+			"jne $1"
+			samecc                                  |       | |
+zge             | source2 |
+			remove(all)
+			test(%[1])
+			"jge $1"
+			samecc                                  |       | |
+zgt             | source2 |
+			remove(all)
+			test(%[1])
+			"jgt $1"
+			samecc                                  |       | |
+cmp zlt		| source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jlo $2"				| | |
+cmp zle		| source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jlos $2"				| | |
+cmp zeq		| source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jeq $2"				| | |
+cmp zne		| source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jne $2"				| | |
+cmp zgt		| source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jhi $2"				| | |
+cmp zge		| source2 source2 |
+			remove(all)
+			"cmp %[2],%[1]"
+			"jhis $2"				| | |
+cmf zlt $1==4	| FLT_REG FLT_REG |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jlt $2"				| | |
+cmf zle $1==4	| FLT_REG FLT_REG |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jle $2"				| | |
+cmf zeq $1==4	| FLT_REG FLT_REG |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jeq $2"				| | |
+cmf zne $1==4	| FLT_REG FLT_REG |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jne $2"				| | |
+cmf zgt $1==4	| FLT_REG FLT_REG |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jgt $2"				| | |
+cmf zge $1==4	| FLT_REG FLT_REG |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jge $2"				| | |
+cmf zlt $1==8	| DBL_REG double8 |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jlt $2"				| | |
+...		| double8 DBL_REG |
+			remove(all)
+			"cmpf %[1],%[2]\ncfcc"
+			"jgt $2"				| | |
+cmf zle $1==8	| DBL_REG double8 |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jle $2"				| | |
+...		| double8 DBL_REG |
+			remove(all)
+			"cmpf %[1],%[2]\ncfcc"
+			"jge $2"				| | |
+cmf zeq $1==8	| DBL_REG double8 |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jeq $2"				| | |
+...		| double8 DBL_REG |
+			remove(all)
+			"cmpf %[1],%[2]\ncfcc"
+			"jeq $2"				| | |
+cmf zne $1==8	| DBL_REG double8 |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jne $2"				| | |
+...		| double8 DBL_REG |
+			remove(all)
+			"cmpf %[1],%[2]\ncfcc"
+			"jne $2"				| | |
+cmf zgt $1==8	| DBL_REG double8 |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jgt $2"				| | |
+...		| double8 DBL_REG |
+			remove(all)
+			"cmpf %[1],%[2]\ncfcc"
+			"jlt $2"				| | |
+cmf zge $1==8	| DBL_REG double8 |
+			remove(all)
+			"cmpf %[2],%[1]\ncfcc"
+			"jge $2"				| | |
+...		| double8 DBL_REG |
+			remove(all)
+			"cmpf %[1],%[2]\ncfcc"
+			"jle $2"				| | |
+
+and zeq $1==2	| source2 source2 |
+			remove(all)
+			"bit %[1],%[2]"
+			"jeq $2"				| | |
+and zne $1==2	| source2 source2 |
+			remove(all)
+			"bit %[1],%[2]"
+			"jne $2"				| | |
+
+/************************************************
+ * group 14 : Procedure call instructions       *
+ ************************************************/
+
+cal             | |     remove(ALL)
+			"jsr pc,$1"                     |       | |
+cai             | REG | remove(ALL)
+			"jsr pc,(%[1])"                 |       | |
+lfr $1==2       | |                                             | r0    | |
+lfr $1==4       | |                                             | r1 r0 | |
+lfr $1==8	| |				| {relative8,"retar"} | |
+lfr             | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,lfr~"
+			erase(r0)                              |       | |
+
+lfr ret $1==$2	| |					       | | ret 0 |
+
+#ifndef REGVARS
+asp lfr ret $2==$3 | |					       | | ret 0 |
+asp ret $2==0	| |					       | | ret 0 |
+#endif
+
+ret $1==0       | |     remove(all)
+#ifdef REGVARS
+			return				       | | |
+#else
+			"mov r5,sp\nmov (sp)+,r5\nrts pc"      |       | |
+#endif
+ret $1==2       | source2 |
+			remove(all)
+			move(%[1],r0)
+#ifdef REGVARS
+			return				       | | |
+#else
+			"mov r5,sp\nmov (sp)+,r5\nrts pc"      |       | |
+#endif
+ret $1==4       |  |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+#ifdef REGVARS
+			return				       | | |
+#else
+			"mov r5,sp\nmov (sp)+,r5\nrts pc"      |       | |
+#endif
+ret $1==8	|	|	| {ADDR_EXTERNAL, "retar"} | sti 8 ret 0  |
+ret             | |     remove(all)
+			move({CONST2,$1},r0)
+			"jmp ret~" 				|       | |
+
+/************************************************
+ * Group 15 : Miscellaneous instructions        *
+ ************************************************/
+
+asp $1==2       | |     remove(all)
+			"tst (sp)+"                             |       | |
+asp $1==4	| |	remove(all)
+			"cmp (sp)+,(sp)+"			|	| |
+asp $1==0-2     | |     remove(all)
+			"tst -(sp)"                             |       | |
+asp             | |     remove(all)
+			"add $$$1,sp"          		|       | |
+ass $1==2       | |     remove(all)
+			"add (sp)+,sp"                  	|       | |
+ass !defined($1)| source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			"add (sp)+,sp"                          |       | |
+
+blm $1==4	| SCR_REG SCR_REG |
+			"mov (%[2])+,(%[1])+"
+			"mov (%[2]),(%[1])"
+			erase(%[1]) erase(%[2])			|	| |
+blm $1==6	| SCR_REG SCR_REG |
+			"mov (%[2])+,(%[1])+"
+			"mov (%[2])+,(%[1])+"
+			"mov (%[2]),(%[1])"
+			erase(%[1]) erase(%[2])			|	| |
+blm $1==8	| SCR_REG SCR_REG |
+			"mov (%[2])+,(%[1])+"
+			"mov (%[2])+,(%[1])+"
+			"mov (%[2])+,(%[1])+"
+			"mov (%[2]),(%[1])"
+			erase(%[1]) erase(%[2])			|	| |
+blm             | SCR_REG SCR_REG |
+			allocate(REG={CONST2,$1/2})
+			"1:mov (%[2])+,(%[1])+\nsob %[a],1b"
+			erase(%[1]) erase (%[2]) erase(%[a])    |       | |
+bls $1==2       | source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,blm~"
+			erase(r01)                              |       | |
+bls !defined($1)| source2 source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			move(%[2],r0)
+			"jsr pc,blm~"
+			erase(r01)                              |       | |
+lae csa $2==2 | source2 |
+			remove(all)
+			move(%[1],r1)
+			move({ADDR_EXTERNAL,$1},r0)
+			"jmp csa~" 				|	| |
+csa $1==2	| |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jmp csa~" 				|       | |
+csa !defined($1)| source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jmp csa~" 				|       | |
+lae csb $2==2	| source2 |
+			remove(all)
+			move(%[1],r1)
+			move({ADDR_EXTERNAL,$1},r0)
+			"jmp csb~"				|	| |
+
+csb $1==2       | |
+			remove(all)
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jmp csb~" 				|	| |
+csb !defined($1)| source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			"mov (sp)+,r0"
+			"mov (sp)+,r1"
+			"jmp csb~" 				|	| |
+dup $1==2       | REG     |             | %[1] %[1]                     | |
+dup $1==4       | NC longf4 | | %[1] %[1]				| |
+...		| source2 source2 |     | %[2] %[1] %[2] %[1]           | |
+dup $1==8	| NC double8| | %[1] %[1]				| |
+...		| |	remove(all)
+			move({CONST2, $1}, r0)
+			"jsr pc,dup~"
+			erase(r01)				|	| |
+dup             | |     remove(all)
+			move({CONST2, $1}, r0)
+			"jsr pc,dup~"
+			erase(r01)                              |       | |
+dus $1==2       | source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,dup~"
+			erase(r01)                              |       | |
+dus !defined($1)| source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			"mov (sp)+,r0"
+			"jsr pc,dup~"
+			erase(r01)                              |       | |
+gto		| |	remove(all)
+			"mov $$$1,-(sp)"
+			"jmp gto~"				|       | |
+fil             | |     "mov $$$1,hol0+4"                       |       | |
+lim             | |             | { relative2, "trpim~"}                | |
+lin             | |     "mov $$$1,hol0"                        |       | |
+lni             | |     "inc hol0"                              |       | |
+lor $1==0       | |                                             | lb    | |
+lor $1==1       | |     remove(all)
+			allocate(REG)
+			"mov sp,%[a]"                   	| %[a]  | |
+lor $1==2       | |     			| {relative2,"reghp~"}  | |
+mon             | |     remove(all)
+			"jsr pc,mon~"                   |       | |
+nop             | |     remove(all)
+			"jsr pc,nop~"                   |       | |
+#ifdef DORCK
+rck $1==2       | source2 |
+			remove(all)
+			move(%[1],r0)
+			"jsr pc,rck~"                   |       | |
+rck !defined($1)| source2 source2 |
+			remove(all)
+			"cmp %[1],$$2"
+			"beq 1f;jmp unknown~;1:"
+			move(%[2],r0)
+			"jsr pc,rck~"                       |       | |
+#else
+rck $1==2	| source2 |				|	| |
+rck !defined($1)| source2 source2 |			|	| |
+#endif
+rtt             | |             |                       | ret 0 |
+sig             | source2 |
+			allocate(REG)
+			move({relative2,"trppc~"},%[a])
+			"mov %[1],trppc~"                       | %[a]  | |
+sim             | |     remove(all)
+			"jsr pc,sim~"                   |       | |
+str $1==0       | source2 |
+			"mov %[1],r5"                   |       | |
+str $1==1       | source2 |
+			remove(all)
+			"mov %[1],sp"                   |       | |
+str $1==2       | |     remove(all)
+			"jsr pc,strhp~"                 |       | |
+trp             | |     remove(all)
+			"jsr pc,trp~"                   |       | |
+exg $1==2       | source2 source2 |                     | %[1] %[2] | |
+exg defined($1) | |     remove(all)
+			move({CONST2,$1},r0)
+			"jsr pc,exg~"                   | | |
+exg             | source2 | remove(all)
+			move(%[1],r0)
+			"jsr pc,exg"                    | | |
+
+lol lal sti $1==$2 && $3==1| | | | | /* throw away funny C-proc-prolog */
+
+/********************************
+ * Coercions                    *
+ *                              *
+ * From EM-tokens to PDP-tokens *
+ ********************************/
+
+| LOCAL2 |      | {regind2,lb,tostring(%[1.ind])} | |
+| LOCAL4 |      | {regind4,lb,tostring(%[1.ind])} | |
+
+/********************************
+ * From source to register      *
+ ********************************/
+
+| regconst2 |   allocate(%[1],REG=%[1.reg])
+		"add $$%[1.ind],%[a]"
+		setcc(%[a])                     | %[a]  | |(6,1050)
+| ADDR_LOCAL |  allocate(REG)
+		"mov r5,%[a]"
+		"add $$%[1.ind],%[a]"
+		setcc(%[a])                     | %[a]  | |(6,1050)
+| REG |                         | {regconst2, %[1], "0"}  | | (2,600)
+| xsource2 |     allocate(%[1], REG=%[1])        | %[a]  | |
+| xsource2 |     allocate(%[1], REG=%[1])        | {regconst2, %[a], "0"}  | |
+| longf4 |      allocate(FLT_REG)
+		move( %[1],%[a])                | %[a]  | | (20,20000) + %[1]
+| double8 |     allocate(DBL_REG)
+		move(%[1],%[a])         | %[a]  | | (20,30000) + %[1]
+
+/********************************
+ * From source1 to source2      *
+ ********************************/
+
+| source1 |     allocate(REG={CONST2,0})
+		"bisb %[1],%[a]"
+		erase(%[a]) setcc(%[a])          | %[a]  | | (6,1050)+%[1]
+
+/********************************
+ * From long4 to source2        *
+ ********************************/
+
+| REG_PAIR |    | %[1.2] %[1.1] | |
+| regind4 |     | {regind2,%[1.reg],"2+"+%[1.ind]} {regind2,%[1.reg],%[1.ind]} | |
+| relative4 |   | {relative2,"2+"+%[1.ind]} {relative2,%[1.ind]}        | |
+| regdef4 |     | {regind2,%[1.reg],"2"} {regdef2,%[1.reg]}               | |
+| LOCAL4 |      | {LOCAL2, %[1.ind]+2, 2} {LOCAL2, %[1.ind], 2}         | |
+
+/********************************
+ * from double8 to long4        *
+ ********************************/
+
+| regind8 |     | {regind4,%[1.reg],"4+"+%[1.ind]} {regind4,%[1.reg],%[1.ind]} | |
+| relative8 |   | {relative4,"4+"+%[1.ind]} {relative4,%[1.ind]}        | |
+| regdef8 |     | {regdef4,%[1.reg]} {regind4,%[1.reg],"4"}               | |
+
+
+
+/************************
+ * From STACK coercions *
+ ************************/
+
+| STACK |       allocate(REG)
+		"mov (sp)+,%[a]"
+		setcc(%[a])                     | %[a]  | | (2,750)
+| STACK |       allocate(REG)
+		"mov (sp)+,%[a]"
+		setcc(%[a])                     | {regconst2, %[a], "0"}  | | (2,750)
+| STACK |       allocate(FLT_REG)
+		"movof (sp)+,%[a]"
+		samecc                          | %[a]  | | (20,47400) /* /10  */
+| STACK |       allocate(DBL_REG)
+		"movf (sp)+,%[a]"
+		samecc                          | %[a]  | | (20,69200) /* /10 */
+| STACK |       allocate(REG_PAIR)
+		"mov (sp)+,%[a.1]"
+		"mov (sp)+,%[a.2]"
+		setcc(%[a.2])                   | %[a]  | | (4,1500)
+
+MOVES:
+(CONST2 %[num] == 0, source2, "clr %[2]" setcc(%[2]),(2,300))
+(source2, source2, "mov %[1],%[2]" setcc(%[2]),(2,300)+%[1]+%[2])
+(FLT_REG, longf4-FLT_REG,"movfo %[1],%[2]" samecc, (2,880) + %[2])
+(longf4-FLT_REG,FLT_REG, "movof %[1],%[2]" samecc, (2,1500) + %[2])
+(FLT_REG, FLT_REG, "movf %[1],%[2]" samecc,(2,880))
+(DBL_REG,double8, "movf %[1],%[2]" samecc,(2,880) + %[2])
+(double8,DBL_REG, "movf %[1],%[2]" samecc,(2,1700) + %[1])
+(CONST2 %[num] == 0,source1, "clrb %[2]" setcc(%[2]),(2,450)+%[2])
+(source1or2,source1, "movb %[1],%[2]" setcc(%[2]),(2,300)+%[1]+%[2])
+(ftoint,source2, "movfi %[1.reg],%[2]" samecc)
+
+TESTS:
+(source2, "tst %[1]" ,(2,300) + %[1])
+(source1, "tstb %[1]",(2,400) + %[1])
+(FLT_REG+DBL_REG, "tstf %[1]\ncfcc" ,(4,2600))
+/* (DBL_REG, "tstf %[1]\ncfcc" ,(4,2600)) */
+
+STACKS:
+( CONST2 %[num]==0 ,, "clr -(sp)"                                             )
+( source2 ,,     "mov %[1],-(sp)" setcc(%[1]),                    (2,900)+%[1])
+( regconst2 ,,   "mov %[1.reg],-(sp)\nadd $$%[1.ind],(sp)" ,          (6,2250))
+( ADDR_LOCAL,,   "mov r5,-(sp)" "add $$%[1.ind],(sp)",               (6,2250))
+( DBL_REG ,,     "movf %[1],-(sp)" samecc             ,               (2,6100))
+( FLT_REG ,,     "movfo %[1],-(sp)" samecc                          , (2,4120))
+( REG_PAIR ,,    "mov %[1.2],-(sp)" "mov %[1.1],-(sp)"              , (4,1800))
+( regind4 ,,     "mov 2+%[1.ind](%[1.reg]),-(sp)"
+		"mov %[1.ind](%[1.reg]),-(sp)"  ,                     (8,3000))
+( relative4 ,,   "mov 2+%[1.ind],-(sp)"
+		"mov %[1.ind],-(sp)"            ,                     (8,3000))
+( regdef4 ,,     "mov 2(%[1.reg]),-(sp)"
+		"mov (%[1.reg]),-(sp)"          ,                     (6,2700))
+( regind8 ,REG,	move(%[1.reg],%[a])
+		"add $$%(8%)+%[1.ind],%[a]"
+		"mov -(%[a]),-(sp)"
+		"mov -(%[a]),-(sp)"
+		"mov -(%[a]),-(sp)"
+		"mov -(%[a]),-(sp)"
+		erase(%[a])			,                    (14,6000))
+( regind8 ,,     "mov 6+%[1.ind](%[1.reg]),-(sp)"
+		"mov 4+%[1.ind](%[1.reg]),-(sp)"
+		"mov 2+%[1.ind](%[1.reg]),-(sp)"
+		"mov %[1.ind](%[1.reg]),-(sp)"  ,                    (16,6000))
+( relative8 ,REG,"mov $$%(8%)+%[1.ind],%[a]"
+		"mov -(%[a]),-(sp)"
+		"mov -(%[a]),-(sp)"
+		"mov -(%[a]),-(sp)"
+		"mov -(%[a]),-(sp)"		,                    (12,5000))
+( relative8 ,,   "mov 6+%[1.ind],-(sp)"
+		"mov 4+%[1.ind],-(sp)"
+		"mov 2+%[1.ind],-(sp)"
+		"mov %[1.ind],-(sp)"            ,                    (16,6000))
+( regdef8 ,,     "mov 6(%[1.reg]),-(sp)"
+		"mov 4(%[1.reg]),-(sp)"
+		"mov 2(%[1.reg]),-(sp)"
+		"mov (%[1.reg]),-(sp)"          ,                    (14,5700))
+( LOCAL4 ,,      "mov 2+%[1.ind](r5),-(sp)"
+		"mov %[1.ind](r5),-(sp)"       ,                     (8,3000))
+( source1 ,,     "clr -(sp)"
+		"movb %[1],(sp)"                ,                (4,1800)+%[1])
+( ftoint ,,	"movfi %[1.reg],-(sp)"		                              )
+( ftolong ,,	"setl\nmovfi %[1.reg],-(sp)\nseti"                            )

+ 178 - 0
mach/proto/cg/Makefile

@@ -0,0 +1,178 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../install cg
+
+cmp:	 all
+	-../compare cg
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	../../../lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

+ 7 - 0
mach/proto/cg/assert.h

@@ -0,0 +1,7 @@
+/* $Header$ */
+
+#ifndef NDEBUG
+#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__)
+#else
+#define assert(x)	/* nothing */
+#endif

+ 672 - 0
mach/proto/cg/codegen.c

@@ -0,0 +1,672 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "state.h"
+#include "equiv.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#define SHORTCUT	/* Stop searching at distance 0 */
+
+#if NREGS >= MAXRULE
+#define MAXPOS NREGS
+#else
+#define MAXPOS MAXRULE
+#endif
+
+#define MAXPATTERN 5
+#define MAXREPLLEN 5    /* Max length of EM-replacement, should come from boot */
+
+byte startupcode[] = { DO_NEXTEM };
+
+byte *nextem();
+unsigned costcalc();
+unsigned docoerc();
+unsigned stackupto();
+string tostring();
+
+#ifdef NDEBUG
+#define DEBUG()
+#else
+#include <stdio.h>
+#define DEBUG(string) {if(Debug) fprintf(stderr,"%-*d%s\n",4*level,level,string);}
+#endif
+
+#define BROKE() {assert(origcp!=startupcode);DEBUG("BROKE");goto doreturn;}
+#define CHKCOST() {if (totalcost>=costlimit) BROKE();}
+
+unsigned codegen(codep,ply,toplevel,costlimit,forced) byte *codep; unsigned costlimit; {
+#ifndef NDEBUG
+	byte *origcp=codep;
+	static int level=0;
+#endif
+	unsigned totalcost = 0;
+	byte *bp;
+	int n;
+	unsigned mindistance,dist;
+	register i;
+	int cindex;
+	int npos,npos2,pos[MAXPOS],pos2[MAXPOS];
+#ifdef STONSTACK
+	state_t state;
+#define SAVEST	savestatus(&state)
+#define RESTST	restorestatus(&state)
+#define FREEST	/* nothing */
+#else
+	state_p state;
+#define SAVEST	state=savestatus()
+#define RESTST	restorestatus(state)
+#define FREEST	freestatus(state)
+#endif
+	unsigned mincost,t;
+	int texpno,nodeno;
+	token_p tp;
+	tkdef_p tdp;
+	int tinstno;
+	struct reginfo *rp,**rpp;
+	token_t token,mtoken,token2;
+	int propno;
+	int exactmatch;
+	int j;
+	int decision;
+	int stringno;
+	result_t result;
+	cost_t cost;
+	int size,lsize,repllen;
+	int tokexp[MAXPATTERN];
+	int nregneeded;
+	token_p regtp[MAXCREG];
+	c3_p regcp[MAXCREG];
+	rl_p regls[MAXCREG];
+	c3_p cp,findcoerc();
+	int sret;
+	token_t reptoken[MAXREPLLEN];
+	int emrepllen,eminstr;
+	int inscoerc=0;
+	int stackpad;
+	struct perm *tup,*ntup,*besttup,*tuples();
+
+#ifndef NDEBUG
+	level++;
+	DEBUG("Entering codegen");
+#endif
+	for (;;) {
+	switch( (*codep++)&037 ) {
+    default:
+	assert(FALSE);
+	/* NOTREACHED */
+    case DO_NEXTEM:
+	DEBUG("NEXTEM");
+	tokpatlen = 0;
+	nallreg=0;
+	if (toplevel) {
+		garbage_collect();
+		totalcost=0;
+	} else {
+		if (--ply <= 0)
+			goto doreturn;
+	}
+	if (stackheight>MAXFSTACK-7)	
+		totalcost += stackupto(&fakestack[6],ply,toplevel);
+	bp = nextem(toplevel);
+	if (bp == 0) {
+		/*
+		 * No pattern found, can be pseudo or error
+		 * in table.
+		 */
+		if (toplevel) {
+			codep--;
+			DEBUG("pseudo");
+			dopseudo();
+		} else
+			goto doreturn;
+	} else {
+#ifndef NDEBUG
+		chkregs();
+#endif
+		n = *bp++;
+		assert(n>0 && n<=MAXRULE);
+		if (n>1) {
+			mindistance = MAXINT; npos=0;
+			for(i=0;i<n;i++) {
+				getint(cindex,bp);
+				dist=distance(cindex);
+#ifndef NDEBUG
+if (Debug)
+	fprintf(stderr,"distance of pos %d is %u\n",i,dist);
+#endif
+				if (dist<=mindistance) {
+					if (dist<mindistance) {
+#ifdef SHORTCUT
+						if(dist==0)
+							goto gotit;
+#endif
+						npos=0;
+						mindistance = dist;
+					}
+					pos[npos++] = cindex;
+				}
+			}
+			assert(mindistance<MAXINT);
+			if (npos>1) {
+				/*
+				 * More than 1 tokenpattern is a candidate.
+				 * Decision has to be made by lookahead.
+				 */
+				SAVEST;
+				mincost = costlimit-totalcost+1;
+				for(i=0;i<npos;i++) {
+					t=codegen(&coderules[pos[i]],ply,FALSE,mincost,0);
+#ifndef NDEBUG
+if (Debug)
+	fprintf(stderr,"mincost %u,cost %u,pos %d\n",mincost,t,i);
+#endif
+					if (t<mincost) {
+						mincost = t;
+						cindex = pos[i];
+					}
+					RESTST;
+				}
+				FREEST;
+				if (totalcost+mincost>costlimit) {
+					totalcost += mincost;
+					BROKE();
+				}
+			} else {
+				cindex = pos[0];
+			}
+		} else {
+			getint(cindex,bp);
+		}
+
+	gotit:
+		/*
+		 * Now cindex contains the code-index of the best candidate
+		 * so proceed to use it.
+		 */
+		codep = &coderules[cindex];
+	}
+	break;
+    case DO_COERC:
+	DEBUG("COERC");
+	tokpatlen=1;
+	inscoerc=1;
+	break;
+    case DO_XXMATCH:
+	DEBUG("XXMATCH");
+    case DO_XMATCH:
+	DEBUG("XMATCH");
+	tokpatlen=(codep[-1]>>5)&07;
+	for (i=0;i<tokpatlen;i++)
+		getint(tokexp[i],codep);
+	tokexp[i]=0;
+	break;	/* match already checked by distance() */
+    case DO_MATCH:
+	DEBUG("MATCH");
+	tokpatlen=(codep[-1]>>5)&07;
+	for(i=0;i<tokpatlen;i++)
+		getint(tokexp[i],codep);
+	tokexp[i] = 0;
+	tp = &fakestack[stackheight-1];
+	i=0;
+	while (i<tokpatlen && tp>=fakestack) {
+		size=tsize(tp);
+		while (i<tokpatlen && (lsize=ssize(tokexp[i]))<=size) {
+			size -= lsize;
+			i++;
+		}
+		if (i<tokpatlen && size!=0) {
+			totalcost += stackupto(tp,ply,toplevel);
+			CHKCOST();
+			break;
+		}
+		tp--;
+	}
+	tp = &fakestack[stackheight-1];
+	i=0;
+	while (i<tokpatlen && tp >= fakestack) {
+		size = tsize(tp);
+		lsize= ssize(tokexp[i]);
+		if (size != lsize) {    /* find coercion */
+#ifdef MAXSPLIT
+			sret = split(tp,&tokexp[i],ply,toplevel);
+			if (sret==0) {
+#endif MAXSPLIT
+				totalcost += stackupto(tp,ply,toplevel);
+				CHKCOST();
+				break;
+#ifdef MAXSPLIT
+			}
+			i += sret;
+#endif MAXSPLIT
+		} else
+			i += 1;
+		tp--;
+	}
+    nextmatch:
+	tp = &fakestack[stackheight-1];
+	i=0; nregneeded = 0;
+	while (i<tokpatlen && tp>=fakestack) {
+		if (!match(tp,&machsets[tokexp[i]],0)) {
+			cp = findcoerc(tp, &machsets[tokexp[i]]);
+			if (cp==0) {
+				for (j=0;j<nregneeded;j++)
+					regtp[j] -= (tp-fakestack+1);
+				totalcost += stackupto(tp,ply,toplevel);
+				CHKCOST();
+				break;
+			} else {
+				if (cp->c3_prop==0) {
+					totalcost+=docoerc(tp,cp,ply,toplevel,0);
+					CHKCOST();
+				} else {
+					assert(nregneeded<MAXCREG);
+					regtp[nregneeded] = tp;
+					regcp[nregneeded] = cp;
+					regls[nregneeded] = curreglist;
+					nregneeded++;
+				}
+			}
+		}
+		i++; tp--;
+	}
+	if (tokpatlen>stackheight) {
+		stackpad = tokpatlen-stackheight;
+		for (j=stackheight-1;j>=0;j--)
+			fakestack[j+stackpad] = fakestack[j];
+		for (j=0;j<stackpad;j++)
+			fakestack[j].t_token=0;
+		stackheight += stackpad;
+		for (j=0;j<nregneeded;j++)
+			regtp[j] += stackpad;
+		tp = &fakestack[stackpad-1];
+		while (i<tokpatlen && tp>=fakestack) {
+			cp = findcoerc((token_p) 0, &machsets[tokexp[i]]);
+			if (cp==0) {
+				assert(!toplevel);
+				for (j=0;j<nregneeded;j++)
+					myfree(regls[j]);
+				totalcost=INFINITY;
+				BROKE();
+			}
+			if (cp->c3_prop==0) {
+				totalcost+=docoerc(tp,cp,ply,toplevel,0);
+				CHKCOST();
+			} else {
+				assert(nregneeded<MAXCREG);
+				regtp[nregneeded] = tp;
+				regcp[nregneeded] = cp;
+				regls[nregneeded] = curreglist;
+				nregneeded++;
+			}
+			i++; tp--;
+		}
+	} else
+		stackpad=0;
+	assert(i==tokpatlen);
+	if (nregneeded==0)
+		break;
+	SAVEST;
+	mincost=costlimit-totalcost+1;
+	tup = tuples(regls,nregneeded);
+	besttup=0;
+	for (; tup != 0; tup = ntup) {
+		ntup = tup->p_next;
+		for (i=0,t=0;i<nregneeded && t<mincost; i++)
+			t += docoerc(regtp[i],regcp[i],ply,FALSE,tup->p_rar[i]);
+		if (t<mincost)
+			t += codegen(codep,ply,FALSE,mincost-t,0);
+		if (t<mincost) {
+			mincost = t;
+			besttup = tup;
+		} else
+			myfree(tup);
+		RESTST;
+	}
+	FREEST;
+	for (i=0;i<nregneeded;i++)
+		myfree(regls[i]);
+	if (totalcost+mincost>costlimit) {
+		if (besttup)
+			myfree(besttup);
+		if (stackpad!=tokpatlen) {
+			if (stackpad) {
+				if (costlimit<MAXINT) {
+					totalcost = costlimit+1;
+					BROKE();
+				}
+				for (i=0;i<stackheight-stackpad;i++)
+					fakestack[i] = fakestack[i+stackpad];
+				stackheight -= stackpad;
+				totalcost += stackupto(&fakestack[stackheight-1],ply,toplevel);
+			} else
+				totalcost += stackupto(fakestack,ply,toplevel);
+			CHKCOST();
+			goto nextmatch;
+		}
+		totalcost += mincost;
+		BROKE();
+	}
+	for (i=0;i<nregneeded;i++)
+		totalcost += docoerc(regtp[i],regcp[i],ply,toplevel,besttup->p_rar[i]);
+	myfree(besttup);
+	break;
+    case DO_REMOVE:
+	DEBUG("REMOVE");
+	if (codep[-1]&32) {
+		getint(texpno,codep);
+		getint(nodeno,codep);
+	} else {
+		getint(texpno,codep);
+		nodeno=0;
+	}
+	for (tp= &fakestack[stackheight-tokpatlen-1];tp>=&fakestack[0];tp--)
+		if (match(tp,&machsets[texpno],nodeno)) {
+			/* investigate possible coercion to register */
+			totalcost += stackupto(tp,ply,toplevel);
+			CHKCOST();
+			break;
+		}
+	for (rp=machregs+2;rp<machregs+NREGS;rp++)
+		if (match(&rp->r_contents,&machsets[texpno],nodeno))
+			rp->r_contents.t_token=0;
+	break;
+    case DO_RREMOVE:	/* register remove */
+	getint(nodeno,codep);
+	result=compute(&enodes[nodeno]);
+	assert(result.e_typ==EV_REG);
+	for (tp= &fakestack[stackheight-tokpatlen-1];tp>=&fakestack[0];tp--)
+		if (tp->t_token==-1) {
+			if(tp->t_att[0].ar==result.e_v.e_con)
+				goto gotone;
+		} else {
+			tdp = &tokens[tp->t_token];
+			for(i=0;i<TOKENSIZE;i++)
+				if (tdp->t_type[i]==EV_REG &&
+				    tp->t_att[i].ar==result.e_v.e_con)
+					goto gotone;
+		}
+	break;
+    gotone:
+	/* investigate possible coercion to register */
+	totalcost += stackupto(tp,ply,toplevel);
+	CHKCOST();
+	break;
+    case DO_DEALLOCATE:
+	DEBUG("DEALLOCATE");
+	getint(tinstno,codep);
+	instance(tinstno,&token);
+	if (token.t_token==-1)
+		chrefcount(token.t_att[0].ar,-1,TRUE);
+	else {
+		tdp= &tokens[token.t_token];
+		for (i=0;i<TOKENSIZE;i++)
+			if (tdp->t_type[i]==EV_REG)
+				chrefcount(token.t_att[i].ar,-1,TRUE);
+	}
+	break;
+    case DO_REALLOCATE:
+	DEBUG("REALLOCATE");
+	for(rp=machregs;rp<machregs+NREGS;rp++)
+		if(rp->r_tcount) {
+			rp->r_refcount -= rp->r_tcount;
+			rp->r_tcount = 0;
+		}
+	break;
+    case DO_ALLOCATE:
+	DEBUG("ALLOCATE");
+	if (codep[-1]&32) {
+		getint(propno,codep);
+		getint(tinstno,codep);
+	} else {
+		getint(propno,codep);
+		tinstno=0;
+	}
+	instance(tinstno,&token);
+	if (!forced) {
+		do {
+			npos=exactmatch=0;
+			for(rpp=reglist[propno];rp= *rpp; rpp++)
+				if (getrefcount(rp-machregs)==0) {
+					pos[npos++] = rp-machregs;
+					if (eqtoken(&rp->r_contents,&token))
+						exactmatch++;
+				}
+			/*
+			 * Now pos[] contains all free registers with desired
+			 * property. If none then some stacking has to take place.
+			 */
+			if (npos==0) {
+				if (stackheight<=tokpatlen) {
+					if (!toplevel) {
+						totalcost = INFINITY;
+						BROKE();
+					} else {
+						fatal("No regs available");
+					}
+				}
+				totalcost += stackupto( &fakestack[0],ply,toplevel);
+				CHKCOST();
+			}
+		} while (npos==0);
+		if (!exactmatch) {
+			npos2=npos;
+			for(i=0;i<npos;i++)
+				pos2[i]=pos[i];
+		} else {
+			/*
+			 * Now we are reducing the number of possible registers.
+			 * We take only one equally likely register out of every
+			 * equivalence class as given by set of properties.
+			 */
+			mtoken = token;
+			npos2=0;
+			for(i=0;i<npos;i++)
+				if (eqtoken(&machregs[pos[i]].r_contents,&mtoken)) {
+					pos2[npos2++] = pos[i];
+					for(j=0;j<npos2-1;j++)
+						if (eqregclass(pos2[j],pos[i])) {
+							npos2--;
+							break;
+						}
+				}
+		}
+		/*
+		 * Now pos2[] contains all possibilities to try, if more than
+		 * one, lookahead is necessary.
+		 */
+		token2.t_token= -1;
+		for (i=1;i<TOKENSIZE;i++)
+			token2.t_att[i].aw=0;
+		if (npos2==1)
+			decision=pos2[0];
+		else {
+			SAVEST;
+			mincost=costlimit-totalcost+1;
+			for(j=0;j<npos2;j++) {
+				chrefcount(pos2[j],1,FALSE);
+				token2.t_att[0].ar=pos2[j];
+				allreg[nallreg++] = pos2[j];
+				if (token.t_token != 0)
+					t=move(&token,&token2,ply,FALSE,mincost);
+				else {
+					t = 0;
+					erasereg(pos2[j]);
+				}
+				if (t<mincost)
+					t += codegen(codep,ply,FALSE,mincost-t,0);
+				if (t<mincost) {
+					mincost=t;
+					decision=pos2[j];
+				}
+				RESTST;
+			}
+			FREEST;
+			if (totalcost+mincost>costlimit) {
+				totalcost = INFINITY;
+				BROKE();
+			}
+		}
+	} else {
+		decision = forced;
+		if (getrefcount(decision)!=0) {
+			totalcost = INFINITY;
+			BROKE();
+		}
+		token2.t_token = -1;
+	}
+	chrefcount(decision,1,FALSE);
+	token2.t_att[0].ar=decision;
+	if (token.t_token != 0) {
+		totalcost+=move(&token,&token2,ply,toplevel,MAXINT);
+		CHKCOST();
+	} else
+		erasereg(decision);
+	allreg[nallreg++]=decision;
+	break;
+    case DO_LOUTPUT:
+	DEBUG("LOUTPUT");
+	getint(stringno,codep);
+	getint(nodeno,codep);
+	if (toplevel) {
+		gencode(codestrings[stringno]);
+		genexpr(nodeno);
+	}
+	break;
+    case DO_ROUTPUT:
+	DEBUG("ROUTPUT");
+	i=((codep[-1]>>5)&07);
+	do {
+		getint(stringno,codep);
+		if (toplevel) {
+			gencode(codestrings[stringno]);
+			gennl();
+		}
+	} while (i--);
+	break;
+    case DO_MOVE:
+	DEBUG("MOVE");
+	getint(tinstno,codep);
+	instance(tinstno,&token);
+	getint(tinstno,codep);
+	instance(tinstno,&token2);
+	totalcost += move(&token,&token2,ply,toplevel,costlimit-totalcost+1);
+	CHKCOST();
+	break;
+    case DO_ERASE:
+	DEBUG("ERASE");
+	getint(nodeno,codep);
+	result=compute(&enodes[nodeno]);
+	assert(result.e_typ==EV_REG);
+	erasereg(result.e_v.e_reg);
+	break;
+    case DO_TOKREPLACE:
+	DEBUG("TOKREPLACE");
+	assert(stackheight>=tokpatlen);
+	repllen=(codep[-1]>>5)&07;
+	for(i=0;i<repllen;i++) {
+		getint(tinstno,codep);
+		instance(tinstno,&reptoken[i]);
+		tref(&reptoken[i],1);
+	}
+	for(i=0;i<tokpatlen;i++) {
+		if (!inscoerc)
+			tref(&fakestack[stackheight-1],-1);
+		stackheight--;
+	}
+	for (i=0;i<repllen;i++) {
+		assert(stackheight<MAXFSTACK);
+		fakestack[stackheight++] = reptoken[i];
+	}
+	for(i=0;i<nallreg;i++)
+		chrefcount(allreg[i],-1,FALSE);
+	break;
+    case DO_EMREPLACE:
+	DEBUG("EMREPLACE");
+	emrepllen=(codep[-1]>>5)&07;
+	j=emp-emlines;
+	if (emrepllen>j) {
+		assert(nemlines+emrepllen-j<MAXEMLINES);
+		for (i=nemlines;i>=0;i--)
+			emlines[i+emrepllen-j] = emlines[i];
+		nemlines += emrepllen-j;
+		emp += emrepllen-j;
+	}
+	emp -= emrepllen;
+	for (i=0;i<emrepllen;i++) {
+		getint(eminstr,codep);
+		getint(nodeno,codep);
+		emp[i].em_instr = eminstr;
+		result = compute(&enodes[nodeno]);
+		switch(result.e_typ) {
+		default:
+			assert(FALSE);
+		case 0:
+			emp[i].em_optyp = OPNO;
+			emp[i].em_soper = 0;
+			break;
+		case EV_INT:
+			emp[i].em_optyp = OPINT;
+			emp[i].em_soper = tostring(result.e_v.e_con);
+			emp[i].em_u.em_ioper = result.e_v.e_con;
+			break;
+		case EV_STR:
+			emp[i].em_optyp = OPSYMBOL;
+			emp[i].em_soper = result.e_v.e_str;
+			break;
+		}
+	}
+	if (!toplevel)
+		ply += emrepllen;
+	break;
+    case DO_COST:
+	DEBUG("COST");
+	getint(cost.c_size,codep);
+	getint(cost.c_time,codep);
+	totalcost += costcalc(cost);
+	CHKCOST();
+	break;
+#ifdef REGVARS
+    case DO_PRETURN:
+	if (toplevel) {
+		swtxt();
+		regreturn();	/* in mach.c */
+	}
+	break;
+#endif
+    case DO_RETURN:
+	DEBUG("RETURN");
+	assert(origcp!=startupcode);
+    doreturn:
+#ifndef NDEBUG
+	level--;
+#endif
+	return(totalcost);
+	}
+	}
+}

+ 364 - 0
mach/proto/cg/compute.c

@@ -0,0 +1,364 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "glosym.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#define LLEAF 01
+#define LDEF  02
+#define RLEAF 04
+#define RDEF  010
+#define LLDEF LLEAF|LDEF
+#define RLDEF RLEAF|RDEF
+
+char opdesc[] = {
+	0,                      /* EX_TOKFIELD */
+	0,                      /* EX_ARG */
+	0,                      /* EX_CON */
+	0,                      /* EX_ALLREG */
+	LLDEF|RLDEF,            /* EX_SAMESIGN */
+	LLDEF|RLDEF,            /* EX_SFIT */
+	LLDEF|RLDEF,            /* EX_UFIT */
+	0,                      /* EX_ROM */
+	LLDEF|RLDEF,            /* EX_NCPEQ */
+	LLDEF|RLDEF,            /* EX_SCPEQ */
+	LLDEF|RLDEF,            /* EX_RCPEQ */
+	LLDEF|RLDEF,            /* EX_NCPNE */
+	LLDEF|RLDEF,            /* EX_SCPNE */
+	LLDEF|RLDEF,            /* EX_RCPNE */
+	LLDEF|RLDEF,            /* EX_NCPGT */
+	LLDEF|RLDEF,            /* EX_NCPGE */
+	LLDEF|RLDEF,            /* EX_NCPLT */
+	LLDEF|RLDEF,            /* EX_NCPLE */
+	LLDEF,                  /* EX_OR2 */
+	LLDEF,                  /* EX_AND2 */
+	LLDEF|RLDEF,            /* EX_PLUS */
+	LLDEF|RLDEF,            /* EX_CAT */
+	LLDEF|RLDEF,            /* EX_MINUS */
+	LLDEF|RLDEF,            /* EX_TIMES */
+	LLDEF|RLDEF,            /* EX_DIVIDE */
+	LLDEF|RLDEF,            /* EX_MOD */
+	LLDEF|RLDEF,            /* EX_LSHIFT */
+	LLDEF|RLDEF,            /* EX_RSHIFT */
+	LLDEF,                  /* EX_NOT */
+	LLDEF,                  /* EX_COMP */
+	0,                      /* EX_COST */
+	0,                      /* EX_STRING */
+	LLEAF,                  /* EX_DEFINED */
+	0,                      /* EX_SUBREG */
+	LLDEF,                  /* EX_TOSTRING */
+	LLDEF,                  /* EX_UMINUS */
+	0,                      /* EX_REG */
+	0,			/* EX_LOWW */
+	0,			/* EX_HIGHW */
+	LLDEF,			/* EX_INREG */
+	LLDEF,			/* EX_REGVAR */
+};
+
+string salloc(),strcpy(),strcat();
+
+string mycat(s1,s2) string s1,s2; {
+	register string s;
+
+	s=salloc(strlen(s1)+strlen(s2));
+	strcpy(s,s1);
+	strcat(s,s2);
+	return(s);
+}
+
+string mystrcpy(s) string s; {
+	register string r;
+
+	r=salloc(strlen(s));
+	strcpy(r,s);
+	return(r);
+}
+
+char digstr[21][15];
+
+string tostring(n) word n; {
+	char buf[25];
+
+	if (n>=-20 && n<=20 && (n&1)==0) {
+		if (digstr[(n>>1)+10][0]==0)
+			sprintf(digstr[(n>>1)+10],WRD_FMT,n);
+		return(digstr[(n>>1)+10]);
+	}
+	sprintf(buf,WRD_FMT,n);
+	return(mystrcpy(buf));
+}
+
+result_t undefres= {EV_UNDEF};
+
+result_t compute(node) node_p node; {
+	result_t leaf1,leaf2,result;
+	token_p tp;
+	int desc;
+	long mask,tmp;
+	int i,tmpreg;
+	glosym_p gp;
+
+	desc=opdesc[node->ex_operator];
+	if (desc&LLEAF) {
+		leaf1 = compute(&enodes[node->ex_lnode]);
+		if (desc&LDEF && leaf1.e_typ==EV_UNDEF)
+			return(undefres);
+	}
+	if (desc&RLEAF) {
+		leaf2 = compute(&enodes[node->ex_rnode]);
+		if (desc&RDEF && leaf2.e_typ==EV_UNDEF)
+			return(undefres);
+	}
+	result.e_typ=EV_INT;
+	switch(node->ex_operator) {
+	default:        assert(FALSE);
+	case EX_TOKFIELD:
+		if (node->ex_lnode!=0)
+			tp = &fakestack[stackheight-node->ex_lnode];
+		else
+			tp = curtoken;
+		switch(result.e_typ = tokens[tp->t_token].t_type[node->ex_rnode-1]) {
+		default:
+			assert(FALSE);
+		case EV_INT:
+			result.e_v.e_con = tp->t_att[node->ex_rnode-1].aw;
+			break;
+		case EV_STR:
+			result.e_v.e_str = tp->t_att[node->ex_rnode-1].as;
+			break;
+		case EV_REG:
+			result.e_v.e_reg = tp->t_att[node->ex_rnode-1].ar;
+			break;
+		}
+		return(result);
+	case EX_ARG:
+		return(dollar[node->ex_lnode-1]);
+	case EX_CON:
+		result.e_typ = EV_INT;
+		result.e_v.e_con = ((long) node->ex_rnode << 16) | ((long)node->ex_lnode&0xffff);
+		return(result);
+	case EX_REG:
+		result.e_typ = EV_REG;
+		result.e_v.e_reg = node->ex_lnode;
+		return(result);
+	case EX_ALLREG:
+		result.e_typ = EV_REG;
+		result.e_v.e_reg = allreg[node->ex_lnode-1];
+#if MAXMEMBERS!=0
+		if (node->ex_rnode!=0)
+			result.e_v.e_reg = machregs[result.e_v.e_reg].
+				r_members[node->ex_rnode-1];
+#endif
+		return(result);
+	case EX_SAMESIGN:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_typ = EV_INT;
+		if (leaf1.e_v.e_con>=0)
+			result.e_v.e_con= leaf2.e_v.e_con>=0;
+		else
+			result.e_v.e_con= leaf2.e_v.e_con<0;
+		return(result);
+	case EX_SFIT:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		mask = 0xFFFFFFFFL;
+		for (i=0;i<leaf2.e_v.e_con-1;i++)
+			mask &= ~(1<<i);
+		tmp = leaf1.e_v.e_con&mask;
+		result.e_v.e_con = tmp==0||tmp==mask;
+		return(result);
+	case EX_UFIT:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		mask = 0xFFFFFFFFL;
+		for (i=0;i<leaf2.e_v.e_con;i++)
+			mask &= ~(1<<i);
+		result.e_v.e_con = (leaf1.e_v.e_con&mask)==0;
+		return(result);
+	case EX_ROM:
+		assert(node->ex_rnode>=0 &&node->ex_rnode<MAXROM);
+		leaf2=dollar[node->ex_lnode];
+		if (leaf2.e_typ != EV_STR)
+			return(undefres);
+		gp = lookglo(leaf2.e_v.e_str);
+		if (gp == (glosym_p) 0)
+			return(undefres);
+		if ((gp->gl_rom[MAXROM]&(1<<node->ex_rnode))==0)
+			return(undefres);
+		result.e_v.e_con = gp->gl_rom[node->ex_rnode];
+		return(result);
+	case EX_LOWW:
+		result.e_v.e_con = saveemp[node->ex_lnode].em_u.em_loper&0xFFFF;
+		return(result);
+	case EX_HIGHW:
+		result.e_v.e_con = saveemp[node->ex_lnode].em_u.em_loper>>16;
+		return(result);
+	case EX_NCPEQ:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con==leaf2.e_v.e_con;
+		return(result);
+	case EX_SCPEQ:
+	assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
+		result.e_v.e_con = !strcmp(leaf1.e_v.e_str,leaf2.e_v.e_str);
+		return(result);
+	case EX_RCPEQ:
+	assert(leaf1.e_typ == EV_REG && leaf2.e_typ == EV_REG);
+		result.e_v.e_con = leaf1.e_v.e_reg==leaf2.e_v.e_reg;
+		return(result);
+	case EX_NCPNE:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con!=leaf2.e_v.e_con;
+		return(result);
+	case EX_SCPNE:
+	assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
+		result.e_v.e_con = strcmp(leaf1.e_v.e_str,leaf2.e_v.e_str);
+		return(result);
+	case EX_RCPNE:
+	assert(leaf1.e_typ == EV_REG && leaf2.e_typ == EV_REG);
+		result.e_v.e_con = leaf1.e_v.e_reg!=leaf2.e_v.e_reg;
+		return(result);
+	case EX_NCPGT:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con>leaf2.e_v.e_con;
+		return(result);
+	case EX_NCPGE:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con>=leaf2.e_v.e_con;
+		return(result);
+	case EX_NCPLT:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con<leaf2.e_v.e_con;
+		return(result);
+	case EX_NCPLE:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con<=leaf2.e_v.e_con;
+		return(result);
+	case EX_OR2:
+	assert(leaf1.e_typ == EV_INT);
+		if (leaf1.e_v.e_con==0)
+			return(compute(&enodes[node->ex_rnode]));
+		return(leaf1);
+	case EX_AND2:
+	assert(leaf1.e_typ == EV_INT);
+		if (leaf1.e_v.e_con!=0)
+			return(compute(&enodes[node->ex_rnode]));
+		return(leaf1);
+	case EX_PLUS:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con=leaf1.e_v.e_con+leaf2.e_v.e_con;
+		return(result);
+	case EX_CAT:
+	assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
+		result.e_typ = EV_STR;
+		result.e_v.e_str = mycat(leaf1.e_v.e_str,leaf2.e_v.e_str);
+		return(result);
+	case EX_MINUS:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con - leaf2.e_v.e_con;
+		return(result);
+	case EX_TIMES:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con * leaf2.e_v.e_con;
+		return(result);
+	case EX_DIVIDE:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con / leaf2.e_v.e_con;
+		return(result);
+	case EX_MOD:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con % leaf2.e_v.e_con;
+		return(result);
+	case EX_LSHIFT:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con << leaf2.e_v.e_con;
+		return(result);
+	case EX_RSHIFT:
+	assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
+		result.e_v.e_con = leaf1.e_v.e_con >> leaf2.e_v.e_con;
+		return(result);
+	case EX_NOT:
+	assert(leaf1.e_typ == EV_INT);
+		result.e_v.e_con = !leaf1.e_v.e_con;
+		return(result);
+	case EX_COMP:
+	assert(leaf1.e_typ == EV_INT);
+		result.e_v.e_con = ~leaf1.e_v.e_con;
+		return(result);
+	case EX_COST:
+		if (node->ex_rnode==0)
+			return(compute(&enodes[tokens[node->ex_lnode].t_cost.c_size]));
+		else
+			return(compute(&enodes[tokens[node->ex_lnode].t_cost.c_time]));
+	case EX_STRING:
+		result.e_typ = EV_STR;
+		result.e_v.e_str = codestrings[node->ex_lnode];
+		return(result);
+	case EX_DEFINED:
+		result.e_v.e_con=leaf1.e_typ!=EV_UNDEF;
+		return(result);
+	case EX_SUBREG:
+		result.e_typ = EV_REG;
+		tp= &fakestack[stackheight-node->ex_lnode];
+		assert(tp->t_token == -1);
+		tmpreg= tp->t_att[0].ar;
+#if MAXMEMBERS!=0
+		if (node->ex_rnode)
+			tmpreg=machregs[tmpreg].r_members[node->ex_rnode-1];
+#endif
+		result.e_v.e_reg=tmpreg;
+		return(result);
+	case EX_TOSTRING:
+	assert(leaf1.e_typ == EV_INT);
+		result.e_typ = EV_STR;
+		result.e_v.e_str = tostring(leaf1.e_v.e_con);
+		return(result);
+#ifdef REGVARS
+	case EX_INREG:
+	assert(leaf1.e_typ == EV_INT);
+		i = isregvar((long) leaf1.e_v.e_con);
+		if (i<0)
+			result.e_v.e_con = 0;
+		else if (i==0)
+			result.e_v.e_con = 1;
+		else
+			result.e_v.e_con = 2;
+		return(result);
+	case EX_REGVAR:
+	assert(leaf1.e_typ == EV_INT);
+		i = isregvar((long) leaf1.e_v.e_con);
+		if (i<=0) 
+			return(undefres);
+		result.e_typ = EV_REG;
+		result.e_v.e_reg=i;
+		return(result);
+#endif
+	case EX_UMINUS:
+	assert(leaf1.e_typ == EV_INT);
+		result.e_v.e_con = -leaf1.e_v.e_con;
+		return(result);
+	}
+}

+ 54 - 0
mach/proto/cg/data.h

@@ -0,0 +1,54 @@
+/* $Header$ */
+
+typedef struct {
+	int     t_token;        /* kind of token, -1 for register */
+	union {
+		word aw;	/* integer type */
+		string as;	/* string type */
+		int ar;		/* register type */
+	} t_att[TOKENSIZE];
+} token_t,*token_p;
+
+struct reginfo {
+	int     r_repr;                 /* index in string table */
+	int     r_size;                 /* size in bytes */
+#if MAXMEMBERS!=0
+	int     r_members[MAXMEMBERS];  /* register contained within this reg */
+	short	r_clash[REGSETSIZE];	/* set of clashing registers */
+#endif
+	int     r_refcount;             /* Times in use */
+	token_t r_contents;             /* Current contents */
+	int     r_tcount;               /* Temporary count difference */
+};
+
+#if MAXMEMBERS!=0
+#define clash(a,b) ((machregs[a].r_clash[(b)>>4]&(1<<((b)&017)))!=0)
+#else
+#define clash(a,b) ((a)==(b))
+#endif
+
+typedef struct {
+	int     t_size;                 /* size in bytes */
+	cost_t  t_cost;                 /* cost in bytes and time */ 
+	byte    t_type[TOKENSIZE];      /* types of attributes, TT_??? */
+	int     t_format;               /* index of formatstring */
+} tkdef_t,*tkdef_p;
+
+struct emline {
+	int     em_instr;
+	int     em_optyp;
+	string  em_soper;
+	union {
+		word    em_ioper;
+		long	em_loper;
+	} em_u;
+};
+
+#define OPNO 0
+#define OPINT 1
+#define OPSYMBOL 2
+
+typedef struct {
+	int rl_n;       /* number in list */
+	int rl_list[NREGS];
+} rl_t,*rl_p;

+ 105 - 0
mach/proto/cg/equiv.c

@@ -0,0 +1,105 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "equiv.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+extern string myalloc();
+
+int rar[MAXCREG];
+rl_p *lar;
+int maxindex;
+int regclass[NREGS];
+struct perm *perms;
+
+struct perm *
+tuples(regls,nregneeded) rl_p *regls; {
+	int class=0;
+	register i,j;
+
+	/*
+	 * First compute equivalence classes of registers.
+	 */
+
+	for (i=0;i<NREGS;i++) {
+		regclass[i] = class++;
+		if (getrefcount(i) == 0) {
+			for (j=0;j<i;j++) {
+				if (eqregclass(i,j) &&
+				    eqtoken(&machregs[i].r_contents,
+					    &machregs[j].r_contents)) {
+					regclass[i] = regclass[j];
+					break;
+				}
+			}
+		}
+	}
+
+	/*
+	 * Now create tuples through a recursive function
+	 */
+
+	maxindex = nregneeded;
+	lar = regls;
+	perms = 0;
+	permute(0);
+	return(perms);
+}
+
+permute(index) {
+	register struct perm *pp;
+	register rl_p rlp;
+	register i,j;
+
+	if (index == maxindex) {
+		for (pp=perms; pp != 0; pp=pp->p_next) {
+			for (i=0; i<maxindex; i++)
+				if (regclass[rar[i]] != regclass[pp->p_rar[i]])
+					goto diff;
+			for (i=0; i<maxindex; i++)
+				for (j=0; j<i; j++)
+					if (clash(rar[i],rar[j]) !=
+					    clash(pp->p_rar[i],pp->p_rar[j]))
+						goto diff;
+			return;
+		    diff: ;
+		}
+		pp = (struct perm *) myalloc(sizeof ( *pp ));
+		pp->p_next = perms;
+		for (i=0; i<maxindex; i++)
+			pp->p_rar[i] = rar[i];
+		perms = pp;
+	} else {
+		rlp=lar[index];
+		for (i=rlp->rl_n-1; i>=0; i--) {
+			rar[index] = rlp->rl_list[i];
+			permute(index+1);
+		}
+	}
+}

+ 8 - 0
mach/proto/cg/equiv.h

@@ -0,0 +1,8 @@
+/* $Header$ */
+
+#define MAXCREG 4
+
+struct perm {
+	struct perm *p_next;
+	int p_rar[MAXCREG];
+};

+ 49 - 0
mach/proto/cg/extern.h

@@ -0,0 +1,49 @@
+/* $Header$ */
+
+extern int maxply;                      /* amount of lookahead allowed */
+extern int stackheight;                 /* # of tokens on fakestack */
+extern token_t fakestack[];             /* fakestack itself */
+extern int nallreg;                     /* number of allocated registers */
+extern int allreg[];                    /* array of allocated registers */
+extern token_p curtoken;                /* pointer to current token */
+extern result_t dollar[];               /* Values of $1,$2 etc.. */
+extern int nemlines;                    /* # of EM instructions in core */
+extern struct emline emlines[];         /* EM instructions itself */
+extern struct emline *emp;              /* pointer to current instr */
+extern struct emline *saveemp;		/* pointer to start of pattern */
+extern int tokpatlen;                   /* length of current stackpattern */
+extern rl_p curreglist;                 /* side effect of findcoerc() */
+#ifndef NDEBUG
+extern int Debug;                       /* on/off debug printout */
+#endif
+
+/*
+ * Next descriptions are external declarations for tables created
+ * by bootgram.
+ * All definitions are to be found in tables.c (Not for humans)
+ */
+
+extern byte coderules[];                /* pseudo code for cg itself */
+extern char stregclass[];               /* static register class */
+extern struct reginfo machregs[];       /* register info */
+extern tkdef_t tokens[];                /* token info */
+extern node_t enodes[];                 /* expression nodes */
+extern string codestrings[];            /* table of strings */
+extern set_t machsets[];                /* token expression table */
+extern inst_t tokeninstances[];         /* token instance description table */
+extern move_t moves[];                  /* move descriptors */
+extern byte pattern[];                  /* EM patterns */
+extern int pathash[256];                /* Indices into previous */
+extern c1_t c1coercs[];                 /* coercions type 1 */
+#ifdef MAXSPLIT
+extern c2_t c2coercs[];                 /* coercions type 2 */
+#endif MAXSPLIT
+extern c3_t c3coercs[];                 /* coercions type 3 */
+extern struct reginfo **reglist[];	/* lists of registers per property */
+
+#define eqregclass(r1,r2) (stregclass[r1]==stregclass[r2])
+
+#ifdef REGVARS
+extern int nregvar[];			/* # of register variables per type */
+extern int *rvnumbers[];		/* lists of numbers */
+#endif

+ 644 - 0
mach/proto/cg/fillem.c

@@ -0,0 +1,644 @@
+#ifndef NORCSID
+static char rcsid2[] = "$Header$";
+#endif
+
+#include <stdio.h>
+#include "assert.h"
+#include <em_spec.h>
+#include <em_pseu.h>
+#include <em_flag.h>
+#include <em_ptyp.h>
+#include <em_mes.h>
+#include "mach.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#ifdef REGVARS
+#include "regvar.h"
+#include <em_reg.h>
+#endif
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+/* segment types for switchseg() */
+#define SEGTXT          0
+#define SEGCON          1
+#define SEGROM          2
+#define SEGBSS          3
+
+long con();
+
+#define get8()  getc(emfile)
+
+#define MAXSTR 256
+
+FILE *emfile;
+extern FILE *codefile;
+
+int nextispseu,savetab1;
+int opcode;
+int offtyp;
+long argval;
+int dlbval;
+char str[MAXSTR],argstr[32],labstr[32];
+int strsiz;
+int holno=0;
+int procno=0;
+int curseg= -1;
+int part_size=0;
+word part_word=0;
+int endofprog=0;
+#ifdef REGVARS
+int regallowed=0;
+#endif
+
+extern char em_flag[];
+extern short em_ptyp[];
+extern long atol();
+extern double atof();
+
+#define sp_cstx sp_cst2
+
+string tostring();
+string holstr();
+string strarg();
+string mystrcpy();
+long get32();
+
+in_init(filename) char *filename; {
+
+	if ((emfile=freopen(filename,"r",stdin))==NULL)
+		error("Can't open %s",filename);
+	if (get16()!=sp_magic)
+		error("Bad format %s",filename);
+}
+
+in_finish() {
+}
+
+fillemlines() {
+	int t,i;
+	register struct emline *lp;
+
+	while ((emlines+nemlines)-emp<MAXEMLINES-5) {
+		assert(nemlines<MAXEMLINES);
+		if (nextispseu) {
+			emlines[nemlines].em_instr=0;
+			return;
+		}
+		lp = &emlines[nemlines++];
+
+		switch(t=table1()) {
+		default:
+			error("unknown instruction byte");
+		case sp_ilb1:
+		case sp_ilb2:
+		case sp_fpseu:
+		case sp_dlb1:
+		case sp_dlb2:
+		case sp_dnam:
+			nextispseu=1; savetab1=t;
+			nemlines--;
+			lp->em_instr = 0;
+			return;
+		case EOF:
+			nextispseu=1; savetab1=t;
+			endofprog=1;
+			nemlines--;
+			lp->em_instr = 0;
+			return;
+		case sp_fmnem:
+			lp->em_instr = opcode;
+			break;
+		}
+		i=em_flag[lp->em_instr-sp_fmnem] & EM_PAR;
+		if ( i == PAR_NO ) {
+			lp->em_optyp = OPNO;
+			lp->em_soper = 0;
+			continue;
+		}
+		t= em_ptyp[i];
+		t= getarg(t);
+		switch(i) {
+		case PAR_L:
+			assert(t == sp_cstx);
+			if (argval >= 0)
+				argval += EM_BSIZE;
+			lp->em_optyp = OPINT;
+			lp->em_u.em_ioper = argval;
+			lp->em_soper = tostring((word) argval);
+			continue;
+		case PAR_G:
+			if (t != sp_cstx)
+				break;
+			lp->em_optyp = OPSYMBOL;
+			lp->em_soper = holstr((word) argval);
+			continue;
+		case PAR_B:
+			t = sp_ilb2;
+			break;
+		case PAR_D:
+			assert(t == sp_cstx);
+			lp->em_optyp = OPSYMBOL;
+			lp->em_soper = strarg(t);
+			lp->em_u.em_loper = argval;
+			continue;
+		}
+		lp->em_soper = strarg(t);
+		if (t==sp_cend)
+			lp->em_optyp = OPNO;
+		else if (t==sp_cstx) {
+			lp->em_optyp = OPINT;
+			lp->em_u.em_ioper = argval;
+		} else
+			lp->em_optyp = OPSYMBOL;
+	}
+}
+
+dopseudo() {
+	register b,t;
+	register full n;
+	register long save;
+	word romcont[MAXROM+1];
+	int nromwords;
+	int rombit,rommask;
+	unsigned dummy,stackupto();
+
+	if (nextispseu==0 || nemlines>0)
+		error("No table entry for %d",emlines[0].em_instr);
+	nextispseu=0;
+	switch(savetab1) {
+	case sp_ilb1:
+	case sp_ilb2:
+		swtxt();
+		dummy = stackupto(&fakestack[stackheight-1],maxply,TRUE);
+		cleanregs();
+		strarg(savetab1);
+		newilb(argstr);
+		return;
+	case sp_dlb1:
+	case sp_dlb2:
+	case sp_dnam:
+		strarg(savetab1);
+		savelab();
+		return;
+	case sp_fpseu:
+		break;
+	case EOF:
+		swtxt();
+		popstr(0);
+		tstoutput();
+		exit(0);
+	default:
+		error("Unknown opcode %d",savetab1);
+	}
+	switch (opcode) {
+	case ps_hol:
+		sprintf(labstr,hol_fmt,++holno);
+	case ps_bss:
+		getarg(cst_ptyp);
+		n = (full) argval;
+		t = getarg(val_ptyp);
+		save = argval;
+		getarg(cst_ptyp);
+		b = (int) argval;
+		argval = save;
+		bss(n,t,b);
+		break;
+	case ps_con:
+		switchseg(SEGCON);
+		dumplab();
+		con(getarg(val_ptyp));
+		while ((t = getarg(any_ptyp)) != sp_cend)
+			con(t);
+		break;
+	case ps_rom:
+		switchseg(SEGROM);
+		xdumplab();
+		nromwords=0;
+		rommask=0;
+		rombit=1;
+		t=getarg(val_ptyp);
+		while (t!=sp_cend) {
+			if (t==sp_cstx && nromwords<MAXROM) {
+				romcont[nromwords] = (word) argval;
+				rommask |= rombit;
+			}
+			nromwords++;
+			rombit <<= 1;
+			con(t);
+			t=getarg(any_ptyp);
+		}
+		if (rommask != 0) {
+			romcont[MAXROM]=rommask;
+			enterglo(labstr,romcont);
+		}
+		labstr[0]=0;
+		break;
+	case ps_mes:
+		getarg(ptyp(sp_cst2));
+		if (argval == ms_emx) {
+			getarg(ptyp(sp_cst2));
+			if (argval != EM_WSIZE)
+				fatal("bad word size");
+			getarg(ptyp(sp_cst2));
+			if (argval != EM_PSIZE)
+				fatal("bad pointer size");
+			if ( getarg(any_ptyp)!=sp_cend )
+				fatal("too many parameters");
+#ifdef REGVARS
+		} else if (argval == ms_gto) {
+			getarg(ptyp(sp_cend));
+			if (!regallowed)
+				error("mes 3 not allowed here");
+			fixregvars(TRUE);
+			regallowed=0;
+		} else if (argval == ms_reg) {
+			long r_off;
+			int r_size,r_type,r_score;
+			struct regvar *linkreg();
+
+			if (!regallowed)
+				error("mes 3 not allowed here");
+			if(getarg(ptyp(sp_cst2)|ptyp(sp_cend)) == sp_cend) {
+				fixregvars(FALSE);
+				regallowed=0;
+			} else {
+				r_off = argval;
+#ifdef EM_BSIZE
+  				if (r_off >= 0)
+  					r_off += EM_BSIZE;
+#endif
+				getarg(ptyp(sp_cst2));
+				r_size = argval;
+				getarg(ptyp(sp_cst2));
+				r_type = argval;
+				if (r_type<reg_any || r_type>reg_float)
+					fatal("Bad type in register message");
+				if(getarg(ptyp(sp_cst2)|ptyp(sp_cend)) == sp_cend)
+					r_score = 0;
+				else {
+					r_score = argval;
+					if ( getarg(any_ptyp)!=sp_cend )
+						fatal("too many parameters");
+				}
+				tryreg(linkreg(r_off,r_size,r_type,r_score),r_type);
+			}
+#endif
+		} else
+			mes((word)argval);
+		break;
+	case ps_exa:
+		strarg(getarg(sym_ptyp));
+		ex_ap(argstr);
+		break;
+	case ps_ina:
+		strarg(getarg(sym_ptyp));
+		in_ap(argstr);
+		break;
+	case ps_exp:
+		strarg(getarg(ptyp(sp_pnam)));
+		ex_ap(argstr);
+		break;
+	case ps_inp:
+		strarg(getarg(ptyp(sp_pnam)));
+		in_ap(argstr);
+		break;
+	case ps_pro:
+		switchseg(SEGTXT);
+		procno++;
+		strarg(getarg(ptyp(sp_pnam)));
+		newilb(argstr);
+		getarg(cst_ptyp);
+		prolog((full)argval);
+#ifdef REGVARS
+		regallowed++;
+#endif
+		break;
+	case ps_end:
+		getarg(cst_ptyp | ptyp(sp_cend));
+		cleanregs();
+#ifdef REGVARS
+		unlinkregs();
+#endif
+		tstoutput();
+		break;
+	default:
+		error("No table entry for %d",savetab1);
+	}
+}
+
+/* ----- input ----- */
+
+int getarg(typset) {
+	register t,argtyp;
+
+	argtyp = t = table2();
+	if (t == EOF)
+		fatal("unexpected EOF");
+	t -= sp_fspec;
+	t = 1 << t;
+	if ((typset & t) == 0)
+		error("bad argument type %d",argtyp);
+	return(argtyp);
+}
+
+int table1() {
+	register i;
+
+	i = get8();
+	if (i < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
+		opcode = i;
+		return(sp_fmnem);
+	}
+	if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {
+		opcode = i;
+		return(sp_fpseu);
+	}
+	if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {
+		argval = i - sp_filb0;
+		return(sp_ilb2);
+	}
+	return(table3(i));
+}
+
+int table2() {
+	register i;
+
+	i = get8();
+	if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) {
+		argval = i - sp_zcst0;
+		return(sp_cstx);
+	}
+	return(table3(i));
+}
+
+int table3(i) {
+	word consiz;
+
+	switch(i) {
+	case sp_ilb1:
+		argval = get8();
+		break;
+	case sp_dlb1:
+		dlbval = get8();
+		break;
+	case sp_dlb2:
+		dlbval = get16();
+		break;
+	case sp_cst2:
+		i = sp_cstx;
+	case sp_ilb2:
+		argval = get16();
+		break;
+	case sp_cst4:
+		i = sp_cstx;
+		argval = get32();
+		break;
+	case sp_dnam:
+	case sp_pnam:
+	case sp_scon:
+		getstring();
+		break;
+	case sp_doff:
+		offtyp = getarg(sym_ptyp);
+		getarg(cst_ptyp);
+		break;
+	case sp_icon:
+	case sp_ucon:
+	case sp_fcon:
+		getarg(cst_ptyp);
+		consiz = (word) argval;
+		getstring();
+		argval = consiz;
+		break;
+	}
+	return(i);
+}
+
+int get16() {
+	register int l_byte, h_byte;
+
+	l_byte = get8();
+	h_byte = get8();
+	if ( h_byte>=128 ) h_byte -= 256 ;
+	return l_byte | (h_byte*256) ;
+}
+
+long get32() {
+	register long l;
+	register int h_byte;
+
+	l = get8();
+	l |= ((unsigned) get8())*256 ;
+	l |= get8()*256L*256L ;
+	h_byte = get8() ;
+	if ( h_byte>=128 ) h_byte -= 256 ;
+	return l | (h_byte*256L*256*256L) ;
+}
+
+getstring() {
+	register char *p;
+	register n;
+
+	getarg(cst_ptyp);
+	if (argval < 0 || argval > MAXSTR-1)
+		fatal("string/identifier too long");
+	strsiz = n = (int) argval;
+	p = str;
+	while (--n >= 0)
+		*p++ = get8();
+	*p++ = '\0';
+}
+
+char *strarg(t) {
+	register char *p;
+
+	switch (t) {
+	case sp_ilb1:
+	case sp_ilb2:
+		sprintf(argstr,ilb_fmt,procno,(int)argval);
+		break;
+	case sp_dlb1:
+	case sp_dlb2:
+		sprintf(argstr,dlb_fmt,dlbval);
+		break;
+	case sp_cstx:
+		sprintf(argstr,cst_fmt,(full)argval);
+		break;
+	case sp_dnam:
+	case sp_pnam:
+		p = argstr;
+		if (strsiz < 8 || str[0] == id_first)
+			*p++ = id_first;
+		sprintf(p,"%.*s",strsiz,str);
+		break;
+	case sp_doff:
+		strarg(offtyp);
+		for (p = argstr; *p; p++)
+			;
+		if (argval >= 0)
+			*p++ = '+';
+		sprintf(p,off_fmt,(full)argval);
+		break;
+	case sp_cend:
+		return("");
+	}
+	return(mystrcpy(argstr));
+}
+
+bss(n,t,b) full n; {
+	register long s;
+
+	if (n % EM_WSIZE)
+		fatal("bad BSS size");
+	if (b==0
+#ifdef BSS_INIT
+	    || (t==sp_cstx && argval==BSS_INIT)
+#endif BSS_INIT
+		) {
+		switchseg(SEGBSS);
+		newlbss(labstr,n);
+		labstr[0]=0;
+		return;
+	}
+	switchseg(SEGCON);
+	dumplab();
+	while (n > 0)
+		n -= (s = con(t));
+	if (s % EM_WSIZE)
+		fatal("bad BSS initializer");
+}
+
+long con(t) {
+	register i;
+
+	strarg(t);
+	switch (t) {
+	case sp_ilb1:
+	case sp_ilb2:
+	case sp_pnam:
+		part_flush();
+		con_ilb(argstr);
+		return((long)EM_PSIZE);
+	case sp_dlb1:
+	case sp_dlb2:
+	case sp_dnam:
+	case sp_doff:
+		part_flush();
+		con_dlb(argstr);
+		return((long)EM_PSIZE);
+	case sp_cstx:
+		con_part(EM_WSIZE,(word)argval);
+		return((long)EM_WSIZE);
+	case sp_scon:
+		for (i = 0; i < strsiz; i++)
+			con_part(1,(word) str[i]);
+		return((long)strsiz);
+	case sp_icon:
+	case sp_ucon:
+		if (argval > EM_WSIZE) {
+			part_flush();
+			con_mult((word)argval);
+		} else {
+			con_part((int)argval,(word)atol(str));
+		}
+		return(argval);
+	case sp_fcon:
+		part_flush();
+		con_float();
+		return(argval);
+	}
+	assert(FALSE);
+	/* NOTREACHED */
+}
+
+extern char *segname[];
+
+swtxt() {
+	switchseg(SEGTXT);
+}
+
+switchseg(s) {
+
+	if (s == curseg)
+		return;
+	part_flush();
+	if ((curseg = s) >= 0)
+		fprintf(codefile,"%s\n",segname[s]);
+}
+
+savelab() {
+	register char *p,*q;
+
+	part_flush();
+	if (labstr[0]) {
+		dlbdlb(argstr,labstr);
+		return;
+	}
+	p = argstr;
+	q = labstr;
+	while (*q++ = *p++)
+		;
+}
+
+dumplab() {
+
+	if (labstr[0] == 0)
+		return;
+	assert(part_size == 0);
+	newdlb(labstr);
+	labstr[0] = 0;
+}
+
+xdumplab() {
+
+	if (labstr[0] == 0)
+		return;
+	assert(part_size == 0);
+	newdlb(labstr);
+}
+
+part_flush() {
+
+	/*
+	 * Each new data fragment and each data label starts at
+	 * a new target machine word
+	 */
+	if (part_size == 0)
+		return;
+	con_cst(part_word);
+	part_size = 0;
+	part_word = 0;
+}
+
+string holstr(n) word n; {
+
+	sprintf(str,hol_off,n,holno);
+	return(mystrcpy(str));
+}
+
+
+/* ----- machine dependent routines ----- */
+
+#include        "mach.c"

+ 194 - 0
mach/proto/cg/gencode.c

@@ -0,0 +1,194 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include <stdio.h>
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+FILE *codefile;
+
+out_init(filename) char *filename; {
+
+#ifndef NDEBUG
+	static char stderrbuff[512];
+
+    if (Debug) {
+	codefile = stderr;
+	if (!isatty(2))
+		setbuf(stderr,stderrbuff);
+    } else {
+#endif
+	if (filename == (char *) 0)
+		codefile = stdout;
+	else
+		if ((codefile=freopen(filename,"w",stdout))==NULL)
+			error("Can't create %s",filename);
+#ifndef NDEBUG
+    }
+#endif
+}
+
+out_finish() {
+
+#ifndef NDEBUG
+	if (Debug)
+		fflush(stderr);
+	else
+#endif
+		fclose(codefile);
+}
+
+tstoutput() {
+
+	if (ferror(codefile))
+		error("Write error on output");
+}
+
+gencode(code) register char *code; {
+	register c;
+	int tokno,fldno,insno,regno,subno;
+	register token_p tp;
+
+	swtxt();
+	while ((c= *code++)!=0) switch(c) {
+	default:
+		fputc(c,codefile);
+		break;
+	case PR_TOK:
+		tokno = *code++;
+		tp = &fakestack[stackheight-tokno];
+		if (tp->t_token==-1)
+			fprintf(codefile,"%s",codestrings[machregs[tp->t_att[0].ar].r_repr]);
+		else
+			prtoken(tp);
+		break;
+	case PR_TOKFLD:
+		tokno = *code++;
+		fldno = *code++;
+		tp = &fakestack[stackheight-tokno];
+		assert(tp->t_token != -1);
+		switch(tokens[tp->t_token].t_type[fldno-1]) {
+		default:
+			assert(FALSE);
+		case EV_INT:
+			fprintf(codefile,WRD_FMT,tp->t_att[fldno-1].aw);
+			break;
+		case EV_STR:
+			fprintf(codefile,"%s",tp->t_att[fldno-1].as);
+			break;
+		case EV_REG:
+			assert(tp->t_att[fldno-1].ar>0 && tp->t_att[fldno-1].ar<NREGS);
+			fprintf(codefile,"%s",codestrings[machregs[tp->t_att[fldno-1].ar].r_repr]);
+			break;
+		}
+		break;
+	case PR_EMINT:
+		insno = *code++;
+		fprintf(codefile,WRD_FMT,dollar[insno-1].e_v.e_con);
+		break;
+	case PR_EMSTR:
+		insno = *code++;
+		fprintf(codefile,"%s",dollar[insno-1].e_v.e_str);
+		break;
+	case PR_ALLREG:
+		regno = *code++;
+		subno = (*code++)&0377;
+		assert(regno>=1 && regno<=nallreg);
+		regno = allreg[regno-1];
+#if MAXMEMBERS!=0
+		if (subno!=255) {
+			assert(subno>=1 && subno<=MAXMEMBERS);
+			regno = machregs[regno].r_members[subno-1];
+			assert(regno!=0);
+		}
+#endif
+		fprintf(codefile,"%s",codestrings[machregs[regno].r_repr]);
+		break;
+#if MAXMEMBERS!=0
+	case PR_SUBREG:
+		tokno = *code++;
+		subno = *code++;
+		tp = &fakestack[stackheight-tokno];
+		assert(tp->t_token == -1);
+		fprintf(codefile,"%s",codestrings[machregs[machregs[tp->t_att[0].ar].r_members[subno-1]].r_repr]);
+		break;
+#endif
+	}
+}
+
+genexpr(nodeno) {
+	result_t result;
+
+	result= compute(&enodes[nodeno]);
+	switch(result.e_typ) {
+	default: assert(FALSE);
+	case EV_INT:
+		fprintf(codefile,WRD_FMT,result.e_v.e_con);
+		break;
+	case EV_REG:
+		fprintf(codefile,"%s", codestrings[machregs[result.e_v.e_reg].r_repr]);
+		break;
+	case EV_STR:
+		fprintf(codefile,"%s",result.e_v.e_str);
+		break;
+	}
+}
+
+gennl() {
+	fputc('\n',codefile);
+}
+
+prtoken(tp) token_p tp; {
+	register c;
+	register char *code;
+	register tkdef_p tdp;
+
+	tdp = &tokens[tp->t_token];
+	assert(tdp->t_format != -1);
+	code = codestrings[tdp->t_format];
+	while ((c = *code++) != 0) {
+		if (c>=' ' && c<='~')
+			fputc(c,codefile);
+		else {
+			assert(c>0 && c<=TOKENSIZE);
+			switch(tdp->t_type[c-1]) {
+			default:
+				assert(FALSE);
+			case EV_INT:
+				fprintf(codefile,WRD_FMT,tp->t_att[c-1].aw);
+				break;
+			case EV_STR:
+				fprintf(codefile,"%s",tp->t_att[c-1].as);
+				break;
+			case EV_REG:
+				fprintf(codefile,"%s",codestrings[machregs[tp->t_att[c-1].ar].r_repr]);
+				break;
+			}
+		}
+	}
+}

+ 52 - 0
mach/proto/cg/glosym.c

@@ -0,0 +1,52 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include "glosym.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+extern string myalloc();
+
+glosym_p glolist= (glosym_p) 0;
+
+enterglo(name,romp) string name; word *romp; {
+	register glosym_p gp;
+	register i;
+
+	gp = (glosym_p) myalloc(sizeof *gp);
+	gp->gl_next = glolist;
+	gp->gl_name = (string) myalloc(strlen(name)+1);
+	strcpy(gp->gl_name,name);
+	for (i=0;i<=MAXROM;i++)
+		gp->gl_rom[i] = romp[i];
+	glolist = gp;
+}
+
+glosym_p lookglo(name) string name; {
+	register glosym_p gp;
+
+	for (gp=glolist;gp != (glosym_p) 0; gp=gp->gl_next)
+		if (strcmp(gp->gl_name,name)==0)
+			return(gp);
+	return((glosym_p) 0);
+}

+ 9 - 0
mach/proto/cg/glosym.h

@@ -0,0 +1,9 @@
+/* $Header$ */
+
+typedef struct glosym {
+	struct glosym *gl_next;
+	string	       gl_name;
+	word	       gl_rom[MAXROM+1];
+} glosym_t,*glosym_p;
+
+glosym_p lookglo();

+ 84 - 0
mach/proto/cg/main.c

@@ -0,0 +1,84 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "param.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+char *progname;
+extern char startupcode[];
+int maxply=1;
+#ifndef NDEBUG
+int Debug=0;
+#endif
+
+extern int endofprog;
+
+main(argc,argv) char **argv; {
+	register unsigned n;
+	extern unsigned cc1,cc2,cc3,cc4;
+	unsigned ggd();
+
+	progname = argv[0];
+	while (--argc && **++argv == '-') {
+		switch(argv[0][1]) {
+#ifndef NDEBUG
+		case 'd':
+			Debug=1; break;
+#endif
+		case 'p':
+			maxply = atoi(argv[0]+2);
+			break;
+		case 'w':	/* weight percentage for size */
+			n=atoi(argv[0]+2);
+			cc1 *= n;
+			cc2 *= 50;
+			cc3 *= (100-n);
+			cc4 *= 50;
+			n=ggd(cc1,cc2);
+			cc1 /= n;
+			cc2 /= n;
+			n=ggd(cc3,cc4);
+			cc3 /= n;
+			cc4 /= n;
+			break;
+		default:
+			error("Unknown flag %c",argv[0][1]);
+		}
+	}
+	if (argc < 1 || argc > 2)
+		error("Usage: %s EMfile [ asfile ]",progname);
+	in_init(argv[0]);
+	out_init(argv[1]);
+	codegen(startupcode,maxply,TRUE,MAXINT,0);
+	in_finish();
+	if (!endofprog)
+		error("Bombed out of codegen");
+	out_finish();
+}
+
+unsigned ggd(a,b) register unsigned a,b; {
+	register unsigned c;
+
+	do {
+		c = a%b; a=b; b=c;
+	} while (c!=0);
+	return(a);
+}

+ 110 - 0
mach/proto/cg/move.c

@@ -0,0 +1,110 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+unsigned costcalc();
+
+move(tp1,tp2,ply,toplevel,maxcost) token_p tp1,tp2; unsigned maxcost; {
+	register move_p mp;
+	register unsigned t;
+	register struct reginfo *rp;
+	tkdef_p tdp;
+	int i;
+	unsigned codegen();
+
+	if (eqtoken(tp1,tp2))
+		return(0);
+	if (tp2->t_token == -1) {
+		if (tp1->t_token == -1) {
+			if (eqtoken(&machregs[tp1->t_att[0].ar].r_contents,
+				    &machregs[tp2->t_att[0].ar].r_contents) &&
+			      machregs[tp1->t_att[0].ar].r_contents.t_token!=0)
+				return(0);
+			if (tp1->t_att[0].ar!=1) { /* COCO reg; tmp kludge */
+				erasereg(tp2->t_att[0].ar);
+				machregs[tp2->t_att[0].ar].r_contents =
+				  machregs[tp1->t_att[0].ar].r_contents ;
+			} else
+				machregs[tp1->t_att[0].ar].r_contents =
+				  machregs[tp2->t_att[0].ar].r_contents ;
+		} else {
+			if (eqtoken(&machregs[tp2->t_att[0].ar].r_contents,tp1))
+				return(0);
+			machregs[tp2->t_att[0].ar].r_contents = *tp1;
+		}
+		for (rp=machregs;rp<machregs+NREGS;rp++) {
+			if (rp->r_contents.t_token == 0)
+				continue;
+			assert(rp->r_contents.t_token > 0);
+			tdp = &tokens[rp->r_contents.t_token];
+			for (i=0;i<TOKENSIZE;i++)
+				if (tdp->t_type[i] == EV_REG &&
+				    clash(rp->r_contents.t_att[i].ar,tp2->t_att[0].ar)) {
+					erasereg(rp-machregs);
+					break;
+				}
+		}
+	} else if (tp1->t_token == -1) {
+		if (eqtoken(tp2,&machregs[tp1->t_att[0].ar].r_contents))
+			return(0);
+		machregs[tp1->t_att[0].ar].r_contents = *tp2;
+	}
+	/*
+	 * If we arrive here the move must really be executed
+	 */
+	for (mp=moves;mp<moves+NMOVES;mp++) {
+		if (!match(tp1,&machsets[mp->m_set1],mp->m_expr1))
+			continue;
+		if (match(tp2,&machsets[mp->m_set2],mp->m_expr2))
+			break;
+		/*
+		 * Correct move rule is found
+		 */
+	}
+	assert(mp<moves+NMOVES);
+	/*
+	 * To get correct interpretation of things like %[1]
+	 * in move code we stack tp2 and tp1. This little trick
+	 * saves a lot of testing in other places.
+	 */
+
+	if (mp->m_cindex!=0) {
+		fakestack[stackheight] = *tp2;
+		fakestack[stackheight+1] = *tp1;
+		stackheight += 2;
+		t = codegen(&coderules[mp->m_cindex],ply,toplevel,maxcost,0);
+		if (t <= maxcost)
+			t += costcalc(mp->m_cost);
+		stackheight -= 2;
+	} else {
+		t = 0;
+	}
+	return(t);
+}

+ 131 - 0
mach/proto/cg/nextem.c

@@ -0,0 +1,131 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include <em_spec.h>
+#include <em_flag.h>
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#ifndef NDEBUG
+#include <stdio.h>
+extern char em_mnem[][4];
+#endif
+
+byte *trypat(bp,len) register byte *bp; {
+	register patlen,i;
+	result_t result;
+
+	getint(patlen,bp);
+	if (len == 3) {
+		if (patlen < 3)
+			return(0);
+	} else {
+		if (patlen != len)
+			return(0);
+	}
+	for(i=0;i<patlen;i++)
+		if (emp[i].em_instr != (*bp++&BMASK))
+			return(0);
+	for (i=0;i<patlen;i++)
+		if (emp[i].em_optyp==OPNO)
+			dollar[i].e_typ=EV_UNDEF;
+		else if ((dollar[i].e_typ=argtyp(emp[i].em_instr))==EV_INT)
+			dollar[i].e_v.e_con=emp[i].em_u.em_ioper;
+		else
+			dollar[i].e_v.e_str=emp[i].em_soper;
+	getint(i,bp);
+	if (i!=0) {
+		result = compute(&enodes[i]);
+		if (result.e_typ != EV_INT || result.e_v.e_con == 0)
+			return(0);
+	}
+#ifndef NDEBUG
+	if (Debug) {
+		fprintf(stderr,"Matched:");
+		for (i=0;i<patlen;i++)
+			fprintf(stderr," %3.3s",em_mnem[emp[i].em_instr-sp_fmnem]);
+		fprintf(stderr,"\n");
+	}
+#endif
+	saveemp = emp;
+	emp += patlen;
+	return(bp);
+}
+
+extern char em_flag[];
+
+argtyp(mn) {
+
+	switch(em_flag[mn-sp_fmnem]&EM_PAR) {
+	case PAR_W:
+	case PAR_S:
+	case PAR_Z:
+	case PAR_O:
+	case PAR_N:
+	case PAR_L:
+	case PAR_F:
+	case PAR_R:
+	case PAR_C:
+		return(EV_INT);
+	default:
+		return(EV_STR);
+	}
+}
+
+byte *nextem(toplevel) {
+	register i;
+	short hash[3];
+	register byte *bp;
+	byte *cp;
+	int index;
+	register struct emline *ep;
+
+	if (toplevel) {
+		if (nemlines && emp>emlines) {
+			nemlines -= emp-emlines;
+			for (i=0,ep=emlines;i<nemlines;i++)
+				*ep++ = *emp++;
+			emp=emlines;
+		}
+		fillemlines();
+	}
+	hash[0] = emp[0].em_instr;
+	hash[1] = (hash[0]<<4) ^ emp[1].em_instr;
+	hash[2] = (hash[1]<<4) ^ emp[2].em_instr;
+	for (i=2;i>=0;i--) {
+		index = pathash[hash[i]&BMASK];
+		while (index != 0) {
+			bp = &pattern[index];
+			if ( bp[PO_HASH] == (hash[i]>>8))
+				if ((cp=trypat(&bp[PO_MATCH],i+1)) != 0)
+					return(cp);
+			index = (bp[PO_NEXT]&BMASK) | (bp[PO_NEXT+1]<<8);
+		}
+	}
+	return(0);
+}

+ 19 - 0
mach/proto/cg/param.h

@@ -0,0 +1,19 @@
+/* $Header$ */
+
+#define BMASK 0377
+#define BSHIFT 8
+
+#define TRUE    1
+#define FALSE   0
+
+#define MAXINT 32767
+#define INFINITY (MAXINT+100)
+
+#define MAXROM 3
+
+/*
+ * Tunable constants
+ */
+
+#define MAXEMLINES 20
+#define MAXFSTACK 20

+ 175 - 0
mach/proto/cg/reg.c

@@ -0,0 +1,175 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+chrefcount(regno,amount,tflag) {
+	register struct reginfo *rp;
+	register i;
+
+	rp= &machregs[regno];
+#if MAXMEMBERS!=0
+	if (rp->r_members[0]==0) {
+#endif
+		rp->r_refcount += amount;
+		if (tflag)
+			rp->r_tcount += amount;
+		assert(rp->r_refcount >= 0);
+#if MAXMEMBERS!=0
+	} else
+		for (i=0;i<MAXMEMBERS;i++)
+			if (rp->r_members[i]!=0)
+				chrefcount(rp->r_members[i],amount,tflag);
+#endif
+}
+
+getrefcount(regno) {
+	register struct reginfo *rp;
+	register i,maxcount;
+
+	rp= &machregs[regno];
+#if MAXMEMBERS!=0
+	if (rp->r_members[0]==0)
+#endif
+		return(rp->r_refcount);
+#if MAXMEMBERS!=0
+	else {
+		maxcount=0;
+		for (i=0;i<MAXMEMBERS;i++)
+			if (rp->r_members[i]!=0)
+				maxcount=max(maxcount,getrefcount(rp->r_members[i]));
+		return(maxcount);
+	}
+#endif
+}
+
+erasereg(regno) {
+	register struct reginfo *rp;
+
+#if MAXMEMBERS==0
+	awayreg(regno);
+#else
+	for (rp=machregs;rp<machregs+NREGS;rp++)
+		if (rp->r_clash[regno>>4]&(1<<(regno&017)))
+			awayreg(rp-machregs);
+#endif
+}
+
+awayreg(regno) {
+	register struct reginfo *rp;
+	register tkdef_p tdp;
+	register i;
+
+	rp = &machregs[regno];
+	rp->r_contents.t_token = 0;
+	for (i=0;i<TOKENSIZE;i++)
+		rp->r_contents.t_att[i].aw = 0;
+
+	/* Now erase recursively all registers containing
+	 * something using this one
+	 */
+	for (rp=machregs;rp<machregs+NREGS;rp++) {
+		if (rp->r_contents.t_token == -1) {
+			if (rp->r_contents.t_att[0].ar == regno)
+				erasereg(rp-machregs);
+		} else {
+			tdp= & tokens[rp->r_contents.t_token];
+			for (i=0;i<TOKENSIZE;i++)
+				if (tdp->t_type[i] == EV_REG && 
+				    rp->r_contents.t_att[i].ar == regno) {
+					erasereg(rp-machregs);
+					break;
+				}
+		}
+	}
+}
+
+cleanregs() {
+	register struct reginfo *rp;
+	register i;
+
+	for (rp=machregs;rp<machregs+NREGS;rp++) {
+		rp->r_contents.t_token = 0;
+		for (i=0;i<TOKENSIZE;i++)
+			rp->r_contents.t_att[i].aw = 0;
+	}
+}
+
+#ifndef NDEBUG
+inctcount(regno) {
+	register struct reginfo *rp;
+	register i;
+
+	rp = &machregs[regno];
+#if MAXMEMBERS!=0
+	if (rp->r_members[0] == 0) {
+#endif
+		rp->r_tcount++;
+#if MAXMEMBERS!=0
+	} else  {
+		for (i=0;i<MAXMEMBERS;i++)
+			if (rp->r_members[i] != 0)
+				inctcount(rp->r_members[i]);
+	}
+#endif
+}
+
+chkregs() {
+	register struct reginfo *rp;
+	register token_p tp;
+	register tkdef_p tdp;
+	int i;
+
+	for (rp=machregs;rp<machregs+NREGS;rp++) {
+		assert(rp->r_tcount==0);
+	}
+	for (tp=fakestack;tp<fakestack+stackheight;tp++) {
+		if (tp->t_token == -1)
+			inctcount(tp->t_att[0].ar);
+		else {
+			tdp = &tokens[tp->t_token];
+			for (i=0;i<TOKENSIZE;i++)
+				if (tdp->t_type[i]==EV_REG)
+					inctcount(tp->t_att[i].ar);
+		}
+	}
+#ifdef REGVARS
+#include <em_reg.h>
+	for(i=reg_any;i<=reg_float;i++) {
+		int j;
+		for(j=0;j<nregvar[i];j++)
+			inctcount(rvnumbers[i][j]);
+	}
+#endif REGVARS
+	for (rp=machregs;rp<machregs+NREGS;rp++) {
+		assert(rp->r_refcount==rp->r_tcount);
+		rp->r_tcount=0;
+	}
+}
+#endif

+ 151 - 0
mach/proto/cg/regvar.c

@@ -0,0 +1,151 @@
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+
+#ifdef REGVARS
+
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "regvar.h"
+#include <em_reg.h>
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+struct regvar *rvlist;
+
+struct regvar *
+linkreg(of,sz,tp,sc) long of; {
+	struct regvar *rvlp;
+
+	rvlp= (struct regvar *) myalloc(sizeof *rvlp);
+	rvlp->rv_next = rvlist;
+	rvlist=rvlp;
+	rvlp->rv_off	= of;
+	rvlp->rv_size	= sz;
+	rvlp->rv_type	= tp;
+	rvlp->rv_score	= sc;
+	rvlp->rv_reg	= 0;	/* no register assigned yet */
+	return(rvlp);
+}
+
+tryreg(rvlp,typ) struct regvar *rvlp; {
+	int score;
+	register i;
+	struct regassigned *ra;
+	struct regvar *save;
+
+	if (typ != reg_any && nregvar[typ]!=0) {
+		if (machregs[rvnumbers[typ][0]].r_size!=rvlp->rv_size)
+			score = -1;
+		else
+			score = regscore(rvlp->rv_off,
+					 rvlp->rv_size,
+					 rvlp->rv_type,
+					 rvlp->rv_score,
+					 typ);	/* machine dependent */
+		ra = regassigned[typ];
+		if (score>ra[nregvar[typ]-1].ra_score) {
+			save = ra[nregvar[typ]-1].ra_rv;
+			for (i=nregvar[typ]-1;i>0 && ra[i-1].ra_score<score;i--)
+				ra[i] = ra[i-1];
+			ra[i].ra_rv = rvlp;
+			ra[i].ra_score = score;
+			if((rvlp=save)==0)
+				return;
+		}
+	}
+	if (nregvar[reg_any]==0)
+		return;
+	if (machregs[rvnumbers[reg_any][0]].r_size!=rvlp->rv_size)
+		score = -1;
+	else
+		score = regscore(rvlp->rv_off,
+				 rvlp->rv_size,
+				 rvlp->rv_type,
+				 rvlp->rv_score,
+				 reg_any);	/* machine dependent */
+	ra = regassigned[reg_any];
+	if (score>ra[nregvar[reg_any]-1].ra_score) {
+		for (i=nregvar[reg_any]-1;i>0 && ra[i-1].ra_score<score;i--)
+			ra[i] = ra[i-1];
+		ra[i].ra_rv = rvlp;
+		ra[i].ra_score = score;
+	}
+}
+
+fixregvars(saveall) {
+	register struct regvar *rv;
+	register rvtyp,i;
+	
+	swtxt();
+	i_regsave();	/* machine dependent initialization */
+	for (rvtyp=reg_any;rvtyp<=reg_float;rvtyp++) {
+	    for(i=0;i<nregvar[rvtyp];i++)
+		if (saveall) {
+			struct reginfo *rp;
+			rp= &machregs[rvnumbers[rvtyp][i]];
+			regsave(codestrings[rp->r_repr],-EM_WSIZE,rp->r_size);
+		} else if(regassigned[rvtyp][i].ra_score>0) {
+			rv=regassigned[rvtyp][i].ra_rv;
+			rv->rv_reg=rvnumbers[rvtyp][i];
+			regsave(codestrings[machregs[rv->rv_reg].r_repr],
+				    rv->rv_off,rv->rv_size);
+		}
+	}
+	f_regsave();
+#ifndef EM_BSIZE
+	for(rv=rvlist;rv!=0;rv=rv->rv_next)
+		if (rv->rv_off >= 0) rv->rv_off += EM_BSIZE;
+#endif
+}
+
+isregvar(off) long off; {
+	register struct regvar *rvlp;
+
+	for(rvlp=rvlist;rvlp!=0;rvlp=rvlp->rv_next)
+		if(rvlp->rv_off == off)
+			return(rvlp->rv_reg);
+	return(-1);
+}
+
+unlinkregs() {
+	register struct regvar *rvlp,*t;
+	register struct regassigned *ra;
+	int rvtyp,i;
+
+	for(rvlp=rvlist;rvlp!=0;rvlp=t) {
+		t=rvlp->rv_next;
+		myfree(rvlp);
+	}
+	rvlist=0;
+	for (rvtyp=reg_any;rvtyp<=reg_float;rvtyp++) {
+	    for(i=0;i<nregvar[rvtyp];i++) {
+		ra= &regassigned[rvtyp][i];
+		ra->ra_rv = 0;
+		ra->ra_score = 0;
+	    }
+	}
+}
+
+#endif REGVARS
+
+/* nothing after this */

+ 19 - 0
mach/proto/cg/regvar.h

@@ -0,0 +1,19 @@
+/* $Header$ */
+
+struct regvar {
+	struct regvar  *rv_next;
+	long		rv_off;
+	int		rv_size;
+	int		rv_type;
+	int		rv_score;
+	int		rv_reg;
+};
+
+struct regassigned {
+	struct regvar  *ra_rv;
+	int		ra_score;
+};
+
+extern struct regvar *rvlist;
+extern int nregvar[];
+extern struct regassigned *regassigned[];

+ 19 - 0
mach/proto/cg/result.h

@@ -0,0 +1,19 @@
+/* $Header$ */
+
+struct result {
+	int	e_typ;		/* EV_INT,EV_REG,EV_STR */
+	union {
+		word e_con;
+		int e_reg;
+		string e_str;
+	} e_v;			/* value */
+};
+
+#define EV_UNDEF 0
+#define EV_INT	1
+#define EV_REG	2
+#define EV_STR	3
+
+typedef struct result result_t;
+
+extern result_t compute();

+ 150 - 0
mach/proto/cg/salloc.c

@@ -0,0 +1,150 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+/*
+ * Package for string allocation and garbage collection.
+ * Call salloc(size) to get room for string.
+ * Every now and then call garbage_collect() from toplevel.
+ */
+
+#define MAXSTAB         500
+#define THRESHOLD       200
+
+char *stab[MAXSTAB];
+int nstab=0;
+string malloc();
+
+string myalloc(size) {
+	register string p;
+
+	p = (string) malloc(size);
+	if (p==0)
+		fatal("Out of memory");
+	return(p);
+}
+
+myfree(p) string p; {
+
+	free(p);
+}
+
+popstr(nnstab) {
+	register i;
+
+	for (i=nnstab;i<nstab;i++)
+		myfree(stab[i]);
+	nstab = nnstab;
+}
+
+char *salloc(size) {
+	register char *p;
+
+	if (nstab==MAXSTAB)
+		fatal("String table overflow");
+	p = myalloc(size+1);    /* extra room for terminating zero */
+	stab[nstab++] = p;
+	return(p);
+}
+
+compar(p1,p2) char **p1,**p2; {
+
+	assert(*p1 != *p2);
+	if (*p1 < *p2)
+		return(-1);
+	return(1);
+}
+
+garbage_collect() {
+	register i;
+	struct emline *emlp;
+	token_p tp;
+	tkdef_p tdp;
+	struct reginfo *rp;
+	register char **fillp,**scanp;
+	char used[MAXSTAB];     /* could be bitarray */
+
+	if (nstab<THRESHOLD)
+		return;
+	qsort(stab,nstab,sizeof (char *),compar);
+	for (i=0;i<nstab;i++)
+		used[i]= FALSE;
+	for(emlp=emlines;emlp<emlines+nemlines;emlp++)
+		chkstr(emlp->em_soper,used);
+	for (tp= fakestack;tp<&fakestack[stackheight];tp++) {
+		if (tp->t_token== -1)
+			continue;
+		tdp = &tokens[tp->t_token];
+		for (i=0;i<TOKENSIZE;i++)
+			if (tdp->t_type[i] == EV_STR)
+				chkstr(tp->t_att[i].as,used);
+	}
+	for (rp= machregs; rp<machregs+NREGS; rp++) {
+		tp = &rp->r_contents;
+		assert(tp->t_token != -1);
+		tdp= &tokens[tp->t_token];
+		for (i=0;i<TOKENSIZE;i++)
+			if (tdp->t_type[i] == EV_STR)
+				chkstr(tp->t_att[i].as,used);
+	}
+	for (i=0;i<nstab;i++)
+		if (!used[i]) {
+			myfree(stab[i]);
+			stab[i]=0;
+		}
+	fillp=stab;
+	for (scanp=stab;scanp<stab+nstab;scanp++)
+		if (*scanp != 0)
+			*fillp++ = *scanp;
+	nstab = fillp-stab;
+}
+
+chkstr(str,used) string str; char used[]; {
+	register low,middle,high;
+
+	low=0; high=nstab-1;
+	while (high>low) {
+		middle= (low+high)>>1;
+		if (str==stab[middle]) {
+			used[middle]=1;
+			return;
+		}
+		if (str<stab[middle])
+			high = middle-1;
+		else
+			low = middle+1;
+	}
+	if (low==high) {
+		if (str==stab[low]) {
+			used[low]=1;
+		}
+		return;
+	}
+}

+ 104 - 0
mach/proto/cg/state.c

@@ -0,0 +1,104 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "state.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+extern int nstab;	/* salloc.c */
+
+#ifndef STONSTACK
+extern string myalloc();
+
+state_p stlist=0;
+#endif
+
+#ifdef STONSTACK
+savestatus(sp) register state_p sp; {
+#else
+state_p savestatus() {
+	register state_p sp;
+
+	if ((sp=stlist)==0)
+		sp = (state_p) myalloc( sizeof( *sp ) );
+	else
+		stlist=sp->st_next;
+#endif
+	sp->st_sh = stackheight;
+	bmove((short *)fakestack,(short *)sp->st_fs,stackheight*sizeof(token_t));
+	sp->st_na = nallreg;
+	bmove((short *)allreg,(short *)sp->st_ar,nallreg*sizeof(int));
+	sp->st_ct = curtoken;
+	bmove((short *)dollar,(short *)sp->st_do,LONGESTPATTERN*sizeof(result_t));
+	bmove((short *)machregs,(short *)sp->st_mr,NREGS*sizeof(struct reginfo));
+	sp->st_ne = nemlines;
+	bmove((short *)emlines,(short *)sp->st_el,nemlines*sizeof(struct emline));
+	sp->st_em = emp;
+	sp->st_se = saveemp;
+	sp->st_tl = tokpatlen;
+	sp->st_ns = nstab;
+#ifndef STONSTACK
+	return(sp);
+#endif
+}
+
+restorestatus(sp) register state_p sp; {
+
+	stackheight = sp->st_sh;
+	bmove((short *)sp->st_fs,(short *)fakestack,stackheight*sizeof(token_t));
+	nallreg = sp->st_na;
+	bmove((short *)sp->st_ar,(short *)allreg,nallreg*sizeof(int));
+	curtoken = sp->st_ct;
+	bmove((short *)sp->st_do,(short *)dollar,LONGESTPATTERN*sizeof(result_t));
+	bmove((short *)sp->st_mr,(short *)machregs,NREGS*sizeof(struct reginfo));
+	nemlines = sp->st_ne;
+	bmove((short *)sp->st_el,(short *)emlines,nemlines*sizeof(struct emline));
+	emp = sp->st_em;
+	saveemp = sp->st_se;
+	tokpatlen = sp->st_tl;
+	popstr(sp->st_ns);
+}
+
+#ifndef STONSTACK
+freestatus(sp) state_p sp; {
+
+	sp->st_next = stlist;
+	stlist = sp;
+}
+#endif
+
+bmove(from,to,nbytes) register short *from,*to; register nbytes; {
+
+	if (nbytes<=0)
+		return;
+	assert(sizeof(short)==2 && (nbytes&1)==0);
+	nbytes>>=1;
+	do
+		*to++ = *from++;
+	while (--nbytes);
+}

+ 24 - 0
mach/proto/cg/state.h

@@ -0,0 +1,24 @@
+/* $Header$ */
+
+#define STONSTACK	/* if defined state is saved in stackframe */
+
+typedef struct state {
+	struct state *st_next;                  /* for linked list */
+	int st_sh;                              /* stackheight */
+	token_t st_fs[MAXFSTACK];               /* fakestack */
+	int st_na;                              /* nallreg */
+	int st_ar[MAXALLREG];                   /* allreg[] */
+	token_p st_ct;                          /* curtoken */
+	result_t st_do[LONGESTPATTERN];         /* dollar[] */
+	struct reginfo st_mr[NREGS];            /* machregs[] */
+	int st_ne;                              /* nemlines */
+	struct emline st_el[MAXEMLINES];        /* emlines[] */
+	struct emline *st_em;                   /* emp */
+	struct emline *st_se;			/* saveemp */
+	int st_tl;				/* tokpatlen */
+	int st_ns;				/* nstab */
+} state_t,*state_p;
+
+#ifndef STONSTACK
+state_p savestatus();
+#endif

+ 547 - 0
mach/proto/cg/subr.c

@@ -0,0 +1,547 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "assert.h"
+#include <stdio.h>
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+#include "extern.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+string myalloc();
+unsigned codegen();
+
+match(tp,tep,optexp) register token_p tp; register set_p tep; {
+	register bitno;
+	token_p ct;
+	result_t result;
+
+	if (tp->t_token == -1) {        /* register frame */
+		bitno = tp->t_att[0].ar+1;
+		if (tep->set_val[bitno>>4]&(1<<(bitno&017)))
+			if (tep->set_val[0]&1 || getrefcount(tp->t_att[0].ar)<=1)
+				goto oklabel;
+		return(0);
+	} else {                /* token frame */
+		bitno = tp->t_token+NREGS+1;
+		if ((tep->set_val[bitno>>4]&(1<<(bitno&017)))==0)
+			return(0);
+	}
+    oklabel:
+	if (optexp==0)
+		return(1);
+	ct=curtoken;
+	curtoken=tp;
+	result=compute(&enodes[optexp]);
+	curtoken=ct;
+	return(result.e_v.e_con);
+}
+
+instance(instno,token) token_p token; {
+	inst_p inp;
+	int i;
+	token_p tp;
+	struct reginfo *rp;
+	int regno;
+	result_t result;
+
+	if (instno==0) {
+		token->t_token = 0;
+		for(i=0;i<TOKENSIZE;i++)
+			token->t_att[i].aw=0;
+		return;
+	}
+	inp= &tokeninstances[instno];
+	switch(inp->in_which) {
+	default:
+		assert(FALSE);
+	case IN_COPY:
+		tp= &fakestack[stackheight-inp->in_info[0]];
+		if (inp->in_info[1]==0) {
+			*token = *tp;
+		} else {
+			token->t_token= -1;
+#if MAXMEMBERS!=0
+			if (tp->t_token == -1) {
+				rp = &machregs[tp->t_att[0].ar];
+				token->t_att[0].ar=rp->r_members[inp->in_info[1]-1];
+			} else {
+#endif
+				assert(tokens[tp->t_token].t_type[inp->in_info[1]-1] == EV_REG);
+				token->t_att[0].ar=tp->t_att[inp->in_info[1]-1].ar;
+#if MAXMEMBERS!=0
+			}
+#endif
+		}
+		return;
+	case IN_RIDENT:
+		token->t_token= -1;
+		token->t_att[0].ar= inp->in_info[0];
+		return;
+#ifdef REGVARS
+	case IN_REGVAR:
+		result=compute(&enodes[inp->in_info[0]]);
+		i=isregvar((long)result.e_v.e_con);
+		assert(i>0);
+		token->t_token= -1;
+		token->t_att[0].ar = i;
+		return;
+#endif
+	case IN_ALLOC:
+		token->t_token= -1;
+		regno=allreg[inp->in_info[0]];
+#if MAXMEMBERS!=0
+		if (inp->in_info[1])
+			regno=machregs[regno].r_members[inp->in_info[1]-1];
+#endif
+		token->t_att[0].ar = regno;
+		return;
+	case IN_DESCR:
+		token->t_token=inp->in_info[0];
+		for (i=0;i<TOKENSIZE;i++)
+			if (inp->in_info[i+1]==0) {
+				assert(tokens[token->t_token].t_type[i]==0);
+				token->t_att[i].aw=0;
+			} else {
+				result=compute(&enodes[inp->in_info[i+1]]);
+				assert(tokens[token->t_token].t_type[i]==result.e_typ);
+				if (result.e_typ==EV_INT)
+					token->t_att[i].aw=result.e_v.e_con;
+				else if (result.e_typ==EV_STR)
+					token->t_att[i].as= result.e_v.e_str;
+				else
+					token->t_att[i].ar=result.e_v.e_reg;
+			}
+		return;
+	}
+}
+
+cinstance(instno,token,tp,regno) token_p token,tp; {
+	inst_p inp;
+	int i;
+	struct reginfo *rp;
+	result_t result;
+	int sh; /* saved stackheight */
+
+	assert(instno!=0);
+	inp= &tokeninstances[instno];
+	switch(inp->in_which) {
+	default:
+		assert(FALSE);
+	case IN_COPY:
+		assert(inp->in_info[0] == 1);
+		if (inp->in_info[1]==0) {
+			*token = *tp;
+		} else {
+			token->t_token= -1;
+#if MAXMEMBERS!=0
+			if (tp->t_token == -1) {
+				rp = &machregs[tp->t_att[0].ar];
+				token->t_att[0].ar=rp->r_members[inp->in_info[1]-1];
+			} else {
+#endif
+				assert(tokens[tp->t_token].t_type[inp->in_info[1]-1] == EV_REG);
+				token->t_att[0].ar=tp->t_att[inp->in_info[1]-1].ar;
+#if MAXMEMBERS!=0
+			}
+#endif
+		}
+		return;
+	case IN_RIDENT:
+		token->t_token= -1;
+		token->t_att[0].ar= inp->in_info[0];
+		return;
+	case IN_ALLOC:
+		token->t_token= -1;
+		assert(inp->in_info[0]==0);
+#if MAXMEMBERS!=0
+		if (inp->in_info[1])
+			regno=machregs[regno].r_members[inp->in_info[1]-1];
+#endif
+		token->t_att[0].ar = regno;
+		return;
+	case IN_DESCR:
+		sh = stackheight;
+		stackheight = tp - fakestack + 1;
+		token->t_token=inp->in_info[0];
+		for (i=0;i<TOKENSIZE;i++)
+			if (inp->in_info[i+1]==0) {
+				assert(tokens[token->t_token].t_type[i]==0);
+				token->t_att[i].aw=0;
+			} else {
+				result=compute(&enodes[inp->in_info[i+1]]);
+				assert(tokens[token->t_token].t_type[i]==result.e_typ);
+				if (result.e_typ==EV_INT)
+					token->t_att[i].aw=result.e_v.e_con;
+				else if (result.e_typ==EV_STR)
+					token->t_att[i].as= result.e_v.e_str;
+				else
+					token->t_att[i].ar=result.e_v.e_reg;
+			}
+		stackheight = sh;
+		return;
+	}
+}
+
+eqtoken(tp1,tp2) token_p tp1,tp2; {
+	register i;
+	register tkdef_p tdp;
+
+	if (tp1->t_token!=tp2->t_token)
+		return(0);
+	if (tp1->t_token==0)
+		return(1);
+	if (tp1->t_token==-1) {
+		if (tp1->t_att[0].ar!=tp2->t_att[0].ar)
+			return(0);
+		return(1);
+	}
+	tdp = &tokens[tp1->t_token];
+	for (i=0;i<TOKENSIZE;i++)
+		switch(tdp->t_type[i]) {
+		default:
+			return(1);
+		case EV_INT:
+			if (tp1->t_att[i].aw != tp2->t_att[i].aw)
+				return(0);
+			break;
+		case EV_REG:
+			if (tp1->t_att[i].ar != tp2->t_att[i].ar)
+				return(0);
+			break;
+		case EV_STR:
+			if (strcmp(tp1->t_att[i].as, tp2->t_att[i].as))
+				return(0);
+			break;
+		}
+	return(1);
+}
+
+distance(cindex) {
+	register char *bp;
+	register i;
+	register token_p tp;
+	int tokexp,tpl;
+	int expsize,toksize,exact;
+	int xsekt=0;
+
+	bp = &coderules[cindex];
+	switch( (*bp)&037 ) {
+	default:
+		return(stackheight==0 ? 0 : 100);
+	case DO_MATCH:
+		break;
+	case DO_XXMATCH:
+		xsekt++;
+	case DO_XMATCH:
+		xsekt++;
+		break;
+	}
+	tpl= ((*bp++)>>5)&07;
+	if (stackheight < tpl) {
+		if (xsekt)
+			return(MAXINT);
+		tpl = stackheight;
+	} else
+		if (stackheight != tpl && xsekt==2)
+			return(MAXINT);
+	exact=0;
+	tp= &fakestack[stackheight-1];
+	for (i=0;i<tpl;i++,tp--) {
+		getint(tokexp,bp);
+		if (!match(tp, &machsets[tokexp], 0)) {
+			if (xsekt)
+				return(MAXINT);
+			expsize = ssize(tokexp);
+			toksize = tsize(tp);
+			if (expsize>toksize)
+				return(100);
+			if (expsize<toksize)
+				return(99-i);
+		} else
+			exact++;
+	}
+	if (exact==tpl) {
+		if (xsekt)
+			return(0);
+		return(10-exact);
+	}
+	return(20-exact);
+}
+
+unsigned costcalc(cost) cost_t cost; {
+	result_t result1,result2;
+	extern unsigned cc1,cc2,cc3,cc4;
+
+	result1=compute(&enodes[cost.c_size]);
+	result2=compute(&enodes[cost.c_time]);
+	assert(result1.e_typ == EV_INT && result2.e_typ == EV_INT);
+	return(result1.e_v.e_con*cc1/cc2 + result2.e_v.e_con*cc3/cc4);
+}
+
+ssize(tokexpno) {
+
+	return(machsets[tokexpno].set_size);
+}
+
+tsize(tp) register token_p tp; {
+
+	if (tp->t_token==-1)
+		return(machregs[tp->t_att[0].ar].r_size);
+	return(tokens[tp->t_token].t_size);
+}
+
+#ifdef MAXSPLIT
+instsize(tinstno,tp) token_p tp; {
+	inst_p inp;
+	struct reginfo *rp;
+
+	inp = &tokeninstances[tinstno];
+	switch(inp->in_which) {
+	default:
+		assert(FALSE);
+	case IN_COPY:
+		assert(inp->in_info[0]==1);
+#if MAXMEMBERS!=0
+		if (inp->in_info[1]==0)
+#endif
+			return(tsize(tp));
+#if MAXMEMBERS!=0
+		else {
+			assert(tp->t_token == -1);
+			rp = &machregs[tp->t_att[0].ar];
+			return(machregs[rp->r_members[inp->in_info[1]-1]].r_size);
+		}
+#endif
+	case IN_RIDENT:
+		return(machregs[inp->in_info[0]].r_size);
+	case IN_ALLOC:
+		assert(FALSE);  /* cannot occur in splitting coercion */
+	case IN_DESCR:
+		return(tokens[inp->in_info[0]].t_size);
+	}
+}
+#endif MAXSPLIT
+
+tref(tp,amount) register token_p tp; {
+	register i;
+	register tkdef_p tdp;
+
+	if (tp->t_token==-1)
+		chrefcount(tp->t_att[0].ar,amount,FALSE);
+	else {
+		tdp= &tokens[tp->t_token];
+		for(i=0;i<TOKENSIZE;i++)
+			if (tdp->t_type[i]==EV_REG)
+				chrefcount(tp->t_att[i].ar,amount,FALSE);
+	}
+}
+
+#define MAXSAVE 10
+
+#ifdef MAXSPLIT
+split(tp,ip,ply,toplevel) token_p tp; int *ip; {
+	c2_p cp;
+	token_t savestack[MAXSAVE];
+	int ok;
+	register i;
+	int diff;
+	token_p stp;
+	int tpl;
+
+	for (cp=c2coercs;cp< &c2coercs[NC2]; cp++) {
+		if (!match(tp,&machsets[cp->c2_texpno],0))
+			continue;
+		ok=1;
+		for (i=0; ok && i<cp->c2_nsplit;i++) {
+			if (ip[i]==0)
+				goto found;
+			if (instsize(cp->c2_repl[i],tp) != ssize(ip[i]))
+				ok=0;
+		}
+		goto found;
+	}
+	return(0);
+found:
+	assert(stackheight+cp->c2_nsplit-1<MAXFSTACK);
+	stp = &fakestack[stackheight-1];
+	diff = stp - tp;
+	assert(diff<=MAXSAVE);
+	for (i=1;i<=diff;i++)
+		savestack[i-1] = tp[i];         /* save top of stack */
+	stackheight -= diff;
+	tpl = tokpatlen;
+	tokpatlen = 1;
+	codegen(&coderules[cp->c2_codep],ply,toplevel,MAXINT,0);
+	tokpatlen = tpl;
+	for (i=0;i<diff;i++)            /* restore top of stack */
+		fakestack[stackheight++] = savestack[i];
+	return(cp->c2_nsplit);
+}
+#endif MAXSPLIT
+
+unsigned docoerc(tp,cp,ply,toplevel,forced) token_p tp; c3_p cp; {
+	token_t savestack[MAXSAVE];
+	token_p stp;
+	int i,diff;
+	unsigned cost;
+	int tpl;        /* saved tokpatlen */
+
+	stp = &fakestack[stackheight-1];
+	diff = stp -tp;
+	assert(diff<=MAXSAVE);
+	for (i=1;i<=diff;i++)
+		savestack[i-1] = tp[i];
+	stackheight -= diff;
+	tpl = tokpatlen;
+	tokpatlen = 1;
+	cost = codegen(&coderules[cp->c3_codep],ply,toplevel,MAXINT,forced);
+	tokpatlen = tpl;
+	for (i=0;i<diff;i++)
+		fakestack[stackheight++] = savestack[i];
+	nallreg = 0;
+	return(cost);
+}
+
+unsigned stackupto(limit,ply,toplevel) token_p limit; {
+	token_t savestack[MAXFSTACK];
+	token_p stp;
+	int i,diff;
+	int tpl;        /* saved tokpatlen */
+	int nareg;	/* saved nareg */
+	int areg[MAXALLREG];
+	c1_p cp;
+	register token_p tp;
+	unsigned totalcost=0;
+	struct reginfo *rp,**rpp;
+
+	for (tp=fakestack;tp<=limit;limit--) {
+		for (cp=c1coercs;cp< &c1coercs[NC1]; cp++) {
+			if (match(tp,&machsets[cp->c1_texpno],cp->c1_expr)) {
+				if (cp->c1_prop>=0) {
+					for (rpp=reglist[cp->c1_prop];
+					       (rp = *rpp)!=0 &&
+					       getrefcount(rp-machregs)!=0;
+						  rpp++)
+						;
+					if (rp==0)
+						continue;
+						/* look for other possibility */
+				}
+				stp = &fakestack[stackheight-1];
+				diff = stp -tp;
+				assert(diff<=MAXFSTACK);
+				for (i=1;i<=diff;i++)
+					savestack[i-1] = tp[i];
+				stackheight -= diff;
+				tpl = tokpatlen;
+				tokpatlen = 1;
+				nareg = nallreg;
+				for (i=0;i<nareg;i++)
+					areg[i] = allreg[i];
+				if (cp->c1_prop>=0) {
+					nallreg=1; allreg[0] = rp-machregs;
+					chrefcount(allreg[0],1,FALSE);
+				} else 
+					nallreg=0;
+				totalcost+= codegen(&coderules[cp->c1_codep],ply,toplevel,MAXINT,0);
+				totalcost+= costcalc(cp->c1_cost);
+				tokpatlen = tpl;
+				for (i=0;i<diff;i++)
+					fakestack[stackheight++] = savestack[i];
+				nallreg=nareg;
+				for (i=0;i<nareg;i++)
+					allreg[i] = areg[i];
+				goto contin;
+			}
+		}
+		assert(FALSE);
+	contin: ;
+	}
+	return(totalcost);
+}
+
+c3_p findcoerc(tp,tep) token_p tp; set_p tep; {
+	register c3_p cp;
+	token_t rtoken;
+	register i;
+	register struct reginfo **rpp;
+
+	for (cp=c3coercs;cp< &c3coercs[NC3]; cp++) {
+		if (tp!=(token_p) 0) {
+			if (!match(tp,&machsets[cp->c3_texpno],0))
+				continue;
+		} else {
+			if (cp->c3_texpno!=0)
+				continue;
+		}
+		if (cp->c3_prop==0) {   /* no reg needed */
+			cinstance(cp->c3_repl,&rtoken,tp,0);
+			if (match(&rtoken,tep,0))
+				return(cp);
+		} else {
+			curreglist = (rl_p) myalloc(sizeof (rl_t));
+			curreglist->rl_n = 0;
+			for (rpp=reglist[cp->c3_prop];*rpp;rpp++) {
+				i = *rpp - machregs;
+				cinstance(cp->c3_repl,&rtoken,tp,i);
+				if (match(&rtoken,tep,0))
+					curreglist->rl_list[curreglist->rl_n++] = i;
+			}
+			if (curreglist->rl_n != 0)
+				return(cp);
+			myfree(curreglist);
+		}
+	}
+	return(0);      /* nothing found */
+}
+
+
+error(s,a1,a2,a3,a4) char *s; {
+
+	fatal(s,a1,a2,a3,a4);
+}
+
+fatal(s,a1,a2,a3,a4) char *s; {
+
+	fprintf(stderr,"Error: ");
+	fprintf(stderr,s,a1,a2,a3,a4);
+	fprintf(stderr,"\n");
+	out_finish();
+	abort();
+	exit(-1);
+}
+
+#ifndef NDEBUG
+badassertion(asstr,file,line) char *asstr, *file; {
+
+	fatal("Assertion \"%s\" failed %s(%d)",asstr,file,line);
+}
+#endif
+
+max(a,b) {
+
+	return(a>b ? a : b);
+}

+ 33 - 0
mach/proto/cg/types.h

@@ -0,0 +1,33 @@
+/* $Header$ */
+
+#ifndef EM_WSIZE
+EM_WSIZE should be defined at this point
+#endif
+#ifndef EM_PSIZE
+EM_PSIZE should be defined at this point
+#endif
+#if EM_WSIZE>4 || EM_PSIZE>4
+Implementation will not be correct unless a long integer
+has more then 4 bytes of precision.
+#endif
+
+typedef char byte;
+typedef char * string;
+
+#if EM_WSIZE>2 || EM_PSIZE>2
+#define full            long
+#else
+#define full            int
+#endif
+
+#if EM_WSIZE>2
+#define word long
+#ifndef WRD_FMT
+#define WRD_FMT "%D"
+#endif WRD_FMT
+#else
+#define word int
+#ifndef WRD_FMT
+#define WRD_FMT "%d"
+#endif WRD_FMT
+#endif

+ 41 - 0
mach/proto/cg/var.c

@@ -0,0 +1,41 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "param.h"
+#include "tables.h"
+#include "types.h"
+#include <cg_pattern.h>
+#include "data.h"
+#include "result.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+int stackheight = 0;
+token_t fakestack[MAXFSTACK];
+int nallreg = 0;
+int allreg[MAXALLREG];
+token_p curtoken = (token_p) 0;
+result_t dollar[LONGESTPATTERN];
+int nemlines =0;
+struct emline emlines[MAXEMLINES];
+struct emline *emp=emlines;
+struct emline *saveemp;
+int tokpatlen;
+rl_p curreglist;

+ 178 - 0
mach/vax4/cg/Makefile

@@ -0,0 +1,178 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../install cg
+
+cmp:	 all
+	-../compare cg
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	../../../lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

+ 178 - 0
mach/z80/cg/Makefile

@@ -0,0 +1,178 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../install cg
+
+cmp:	 all
+	-../compare cg
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	../../../lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

+ 178 - 0
mach/z8000/cg/Makefile

@@ -0,0 +1,178 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../install cg
+
+cmp:	 all
+	-../compare cg
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	../../../lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

+ 23 - 0
util/ack/.distr

@@ -0,0 +1,23 @@
+Makefile
+ack.h
+data.c
+data.h
+dmach.c
+dmach.h
+files.c
+grows.c
+grows.h
+intable.c
+list.c
+list.h
+main.c
+malloc.c
+mktables.c
+pc
+rmach.c
+run.c
+scan.c
+svars.c
+trans.c
+trans.h
+util.c

+ 63 - 0
util/ack/Makefile

@@ -0,0 +1,63 @@
+HFILES=ack.h list.h trans.h data.h dmach.h grows.h
+DSRC=list.c data.c main.c scan.c svars.c trans.c util.c rmach.c run.c grows.c\
+     files.c
+ISRC=dmach.c intable.c
+OBJ=list.o data.o main.o scan.o svars.o trans.o util.o rmach.o run.o \
+    dmach.o intable.o grows.o files.o
+ACKDIR=../../lib/ack
+FE=fe
+INTABLES=pdp int
+LNTABLES=6500 m68k2 m68k4 6809 8080 acc apc nascom vax2 vax4 z80 i86
+CFLAGS=-O -n
+BINDIR=../../bin
+
+head:   ack
+
+install:	ack
+		cp ack $(BINDIR)/ack
+		-cd $(BINDIR) ; \
+		for i in $(INTABLES) $(LNTABLES) ; do ln ack $$i ; done
+		(cd pc ; make install )
+
+cmp:		ack
+		cmp ack $(BINDIR)/ack
+		(cd pc ; make cmp )
+
+clean:
+		-rm -f *.old *.o ack
+		(cd pc ; make clean )
+
+ack:    $(OBJ)
+	$(CC) -o ack $(CFLAGS) $(OBJ)
+
+grows.o files.o list.o run.o \
+data.o main.o scan.o trans.o rmach.o util.o : ack.h list.h
+
+files.o data.o main.o scan.o run.o trans.o rmach.o: trans.h data.h
+
+files.o rmach.o trans.o grows.c : grows.h
+
+rmach.c: dmach.h
+
+files.o main.o rmach.o : ../../h/em_path.h
+
+main.o : ../../h/local.h
+
+malloc.o svars.o:	ack.h
+
+dmach.c intable.c: mktables dmach.h
+	: mktables $(ACKDIR) # $(FE) $(INTABLES)
+	mktables $(ACKDIR)
+
+mktables:       mktables.c
+	cc -o mktables mktables.c
+
+pr:
+	@pr Makefile $(HFILES) $(DSRC) $(ACKDIR)/*
+	@(cd pc ; make pr)
+
+opr:
+	make pr | opr
+
+lint:   $(ISRC)
+	lint -hbx $(DSRC) $(ISRC)

+ 88 - 0
util/ack/ack.h

@@ -0,0 +1,88 @@
+/****************************************************************************/
+/*                      User settable options                               */
+/****************************************************************************/
+
+#define FRONTENDS       "fe"    /* The front-end definitions */
+#define ACKNAME         "AckXXXXXX"     /* Handed to mktemp for temp. files */
+
+/****************************************************************************/
+/*         Internal mnemonics, should not be tinkered with                  */
+/****************************************************************************/
+
+/* The names of some string variables */
+
+#define HOME    "EM"
+#define RTS     "RTS"
+#define NEEDS   "NEEDS"
+#define HEAD    "HEAD"
+#define TAIL    "TAIL"
+#define SRC     "SOURCE"
+#define LIBVAR	"LNAME"
+
+/* Intended for flags, possibly in bit fields */
+
+#define YES     1
+#define NO      0
+#define MAYBE   2
+
+#define EXTERN  extern
+
+#define SUFCHAR '.'             /* Start of SUFFIX in file name */
+#define SPACE   ' '
+#define TAB     '\t'
+#define EQUAL   '='
+#define S_VAR   '{'             /* Start of variable */
+#define C_VAR   '}'             /* End of variable */
+#define A_VAR   '?'             /* Variable alternative */
+#define BSLASH  '\\'            /* Backslash */
+#define STAR    '*'             /* STAR */
+#define C_IN    '<'             /* Token specifying input */
+#define C_OUT   '>'             /* Token specifying output */
+#define S_EXPR  '('             /* Start of expression */
+#define C_EXPR  ')'             /* End of expression */
+#define M_EXPR  ':'             /* Middle of two suffix lists */
+#define T_EXPR  '='             /* Start of tail */
+
+#define NO_SCAN 0200            /* Bit set in character to defeat recogn. */
+
+typedef struct {
+	char    *p_path;        /* points to the full pathname */
+	int     p_keeps:1;      /* The string should be thrown when unused */
+	int     p_keep:1;       /* The file should be thrown away after use */
+} path ;
+
+/* Return values of setpath() */
+enum f_path { F_OK, F_NOMATCH, F_NOPATH } ;
+
+/* Library routines */
+
+extern char *index();
+extern char *rindex();
+extern char *strcpy();
+extern char *strcat();
+extern char *mktemp();
+extern int  unlink();
+extern int  close();
+extern int  open();
+extern int  creat();
+
+/* Own routines */
+enum f_path setpath();
+enum f_path scan_end();
+extern int  noodstop();
+extern char *getvar();
+extern char *keeps();
+extern char *basename();
+extern char *skipblank();
+extern char *firstblank();
+extern char *getcore();
+extern char *changecore();
+#define freecore(area)  free(area)
+
+/* #define DEBUG	1	/* Allow debugging of Ack */
+
+#ifndef DEBUG
+#  define debug 0       /* To surprise all these 'if ( debug ) 's */
+#else
+extern  int debug ;
+#endif

+ 9 - 0
util/ack/data.c

@@ -0,0 +1,9 @@
+#include "ack.h"
+#include "list.h"
+#include "trans.h"
+
+
+#undef EXTERN
+#define EXTERN
+
+#include "data.h"

+ 43 - 0
util/ack/data.h

@@ -0,0 +1,43 @@
+EXTERN  char            *stopsuffix;    /* Suffix to stop at */
+EXTERN  char            *machine;       /* The machine id */
+EXTERN  char            *rts;           /* The runtime-system id */
+
+EXTERN  list_head       arguments;      /* List of arguments */
+EXTERN  list_head       flags;          /* List of flags */
+
+EXTERN  list_head       c_arguments;    /* List of linker arguments */
+
+EXTERN  list_head       tr_list;        /* List of transformations */
+
+EXTERN  list_head       R_list;         /* List of -R flags */
+EXTERN  list_head       head_list;      /* List of suffices for headers */
+EXTERN  list_head       tail_list;      /* List of suffices for tails */
+
+EXTERN  int             k_flag;         /* Like -k of lint */
+EXTERN  int             g_flag;         /* do_run() */
+EXTERN  int             t_flag;         /* Preserve intermediate files */
+EXTERN  int             v_flag;         /* Verbose */
+EXTERN  int             w_flag;         /* Don't print warnings */
+EXTERN  int             nill_flag;      /* Don't file names */
+EXTERN  int             Optflag;        /* Optimizing */
+
+#ifdef DEBUG
+EXTERN  int             debug;          /* Debugging control */
+#endif
+
+EXTERN  int             n_error;        /* Number of errors encountered */
+
+EXTERN  char            *progname;      /* The program call name */
+
+EXTERN  char            *outfile;       /* The result file e.g. a.out */
+EXTERN  char            *template;      /* The template for temporary file
+						names */
+
+EXTERN  trf             *combiner;      /* Pointer to the Loader/Linker */
+EXTERN  trf             *cpp_trafo;     /* Pointer to C-preprocessor */
+
+EXTERN  path            in;             /* The current input pathname */
+EXTERN  path            out;            /* The current output pathname */
+EXTERN  path            orig;           /* The original input path */
+EXTERN  char            *p_basename;    /* The current basename */
+EXTERN  char            *p_suffix;      /* The current input suffix */

+ 15 - 0
util/ack/dmach.h

@@ -0,0 +1,15 @@
+/***************************************************************/
+/*                                                             */
+/*   Definition for table that maps a name on an intable index */
+/*                                                             */
+/***************************************************************/
+
+
+typedef struct {
+	char *ma_name ;         /* The name of the machine */
+	int   ma_index ;
+} dmach ;
+
+extern dmach massoc[] ;
+
+extern char  intable[] ;

+ 94 - 0
util/ack/files.c

@@ -0,0 +1,94 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "list.h"
+#include "trans.h"
+#include "grows.h"
+#include "data.h"
+#include "../../h/em_path.h"
+
+setfiles(phase) register trf *phase ; {
+	/* Set the out structure according to the in structure,
+	   the transformation and some global data */
+	growstring pathname ;
+	register list_elem *elem ;
+
+	if ( phase->t_combine ) {
+		out.p_keep=YES ;
+		out.p_path=outfile ;
+		out.p_keeps=NO ;
+		in.p_path= (char *)0 ;
+		in.p_keep=YES ;
+		in.p_keeps=NO ;
+	} else {
+		gr_init(&pathname) ;
+		if ( !phase->t_keep && !t_flag ) {
+			gr_cat(&pathname,TMP_DIR) ;
+			gr_cat(&pathname,"/") ;
+			gr_cat(&pathname,template) ;
+			out.p_keep=NO ;
+		} else {
+			gr_cat(&pathname,p_basename) ;
+			out.p_keep=YES ;
+		}
+		gr_cat(&pathname,phase->t_out) ;
+		out.p_path= gr_final(&pathname) ;
+		out.p_keeps= YES ;
+	}
+	scanlist( l_first(arguments), elem) {
+		if ( strcmp(l_content(*elem),out.p_path)==0 ) {
+			error("attempt to overwrite argument file") ;
+			return 0 ;
+		}
+	}
+	return 1 ;
+}
+
+disc_files() {
+	if ( in.p_path ) {
+		if ( !in.p_keep ) {
+			if ( unlink(in.p_path)!=0 ) {
+				werror("couldn't unlink %s",in.p_path);
+			}
+		}
+		if ( in.p_keeps ) throws(in.p_path) ;
+	}
+	in=out ;
+	out.p_path= (char *)0 ;
+	out.p_keeps=NO ;
+	out.p_keep=NO ;
+}
+
+rmtemps() {
+	/* Called in case of disaster, always remove the current output file!
+	*/
+	if ( out.p_path ) {
+		unlink(out.p_path) ;
+		if ( out.p_keeps ) throws(out.p_path) ;
+		out.p_path= (char *)0 ;
+		out.p_keeps=NO ;
+		out.p_keep=NO ;
+	}
+	if ( !in.p_keep && in.p_path ) {
+		unlink(in.p_path) ;
+		if ( in.p_keeps ) throws(in.p_path) ;
+		in.p_path= (char *)0 ;
+		out.p_keeps= NO ;
+		out.p_keep=NO ;
+	}
+}

+ 79 - 0
util/ack/grows.c

@@ -0,0 +1,79 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/**************************************************************************/
+/*                                                                        */
+/*                 Bookkeeping for growing strings                        */
+/*                                                                        */
+/**************************************************************************/
+
+#include "ack.h"
+#include "grows.h"
+
+gr_add(id,c) register growstring *id ; char c ; {
+	if ( id->gr_size==id->gr_max) {
+		if ( id->gr_size==0 ) { /* The first time */
+			id->gr_max= 2*GR_MORE ;
+			id->gr_string= getcore(id->gr_max) ;
+		} else {
+			id->gr_max += GR_MORE ;
+			id->gr_string= changecore(id->gr_string,id->gr_max ) ;
+		}
+	}
+	*(id->gr_string+id->gr_size++)= c ;
+}
+
+gr_cat(id,string) growstring *id ; char *string ; {
+	register char *ptr ;
+
+#ifdef DEBUG
+	if ( id->gr_size && *(id->gr_string+id->gr_size-1) ) {
+		vprint("Non-zero terminated %*s\n",
+			id->gr_size, id->gr_string ) ;
+	}
+#endif
+	if ( id->gr_size ) id->gr_size-- ;
+	ptr=string ;
+	for (;;) {
+		gr_add(id,*ptr) ;
+		if ( *ptr++ ) continue ;
+		break ;
+	}
+}
+
+gr_throw(id) register growstring *id ; {
+	/* Throw the string away */
+	if ( id->gr_max==0 ) return ;
+	freecore(id->gr_string) ;
+	id->gr_max=0 ;
+	id->gr_size=0 ;
+}
+
+gr_init(id) growstring *id ; {
+	id->gr_size=0 ; id->gr_max=0 ;
+}
+
+char *gr_final(id) growstring *id ; {
+	/* Throw away the bookkeeping, adjust the string to its final
+	   length and return a pointer to a string to be get rid of with
+	   throws
+	*/
+	register char *retval ;
+	retval= keeps(gr_start(*id)) ;
+	gr_throw(id) ;
+	return retval ;
+}

+ 19 - 0
util/ack/grows.h

@@ -0,0 +1,19 @@
+/* struct used to identify and do bookkeeping for growing strings */
+
+typedef struct {
+	char            *gr_string ;    /* Points to start of string */
+	unsigned        gr_size ;       /* Current string size */
+	unsigned        gr_max ;        /* Maximum string size */
+} growstring ;
+
+#define GR_MORE         50      /* Steps to grow */
+
+#define gr_start(id)    (id).gr_string  /* The start of the string */
+
+/* Routines used */
+
+extern  int     gr_throw() ;    /* To free the core */
+extern  int     gr_add() ;      /* To add one character */
+extern  int     gr_cat() ;      /* concatenate the contents and the string */
+extern  int     gr_init() ;     /* Initialize the bookkeeping */
+extern  char    *gr_final() ;   /* Transform to a stable storage string */

+ 73 - 0
util/ack/list.c

@@ -0,0 +1,73 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "list.h"
+
+/* List handling, operations allowed:
+	adding strings to the list,
+	throwing away whole lists,
+	linearize a list.
+
+Routines:
+	l_add(header,string) Add an element to a list.
+		header          List header, list_head *
+		string          String pointer, char *
+					the string is NOT copied
+
+	l_clear(header)      Delete an whole list.
+		header          List header, list_head *
+
+*/
+
+
+l_add(header,string) list_head *header ; char *string ; {
+	register list_elem *new;
+
+	/* NOSTRICT */
+	new= (list_elem *)getcore(sizeof *new);
+	l_content(*new)= string ;
+	/* NOSTRICT */
+	l_next(*new)= (list_elem *)0 ;
+	if ( !header->ca_first ) {
+		header->ca_first= new ;
+	} else {
+		header->ca_last->ca_next= new ;
+	}
+	header->ca_last= new ;
+}
+
+l_clear(header) list_head *header ; {
+	register list_elem *old, *next;
+	for ( old=header->ca_first ; old ; old= next ) {
+		next= old->ca_next ;
+		freecore((char *)old) ;
+	}
+	header->ca_first= (list_elem *) 0 ;
+	header->ca_last = (list_elem *) 0 ;
+}
+
+l_throw(header) list_head *header ; {
+	register list_elem *old, *next;
+	for ( old=header->ca_first ; old ; old= next ) {
+		throws(l_content(*old)) ;
+		next= old->ca_next ;
+		freecore((char *)old) ;
+	}
+	header->ca_first= (list_elem *) 0 ;
+	header->ca_last = (list_elem *) 0 ;
+}

+ 23 - 0
util/ack/list.h

@@ -0,0 +1,23 @@
+struct ca_elem {
+	struct ca_elem          *ca_next; /* The link */
+	char                    *ca_cont; /* The contents */
+} ;
+
+struct ca_list {
+	struct ca_elem          *ca_first; /* The head */
+	struct ca_elem          *ca_last;  /* The tail */
+} ;
+
+typedef struct ca_list list_head ;         /* The decl. for headers */
+typedef struct ca_elem list_elem ;         /* The decl. for elements */
+
+/* Some operations */
+
+/* Access */
+#define l_first(header)         (header).ca_first
+#define l_next(elem)            (elem).ca_next
+#define l_content(elem)         (elem).ca_cont
+
+/* To be used for scanning lists, ptr is the running variable */
+#define scanlist(elem,ptr) \
+	for ( ptr= elem ; ptr; ptr= l_next(*ptr) )

+ 340 - 0
util/ack/main.c

@@ -0,0 +1,340 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "list.h"
+#include "trans.h"
+#include "../../h/em_path.h"
+#include "../../h/local.h"
+#include "data.h"
+#include <signal.h>
+
+static int sigs[] = { SIGINT, SIGHUP, SIGTERM, 0 } ;
+
+extern  char    *getenv();
+
+main(argc,argv) char **argv ; {
+	register list_elem *elem ;
+	register char *frontend ;
+	register int *n_sig ;
+
+	progname=argv[0];
+	varinit();
+	vieuwargs(argc,argv);
+	if ( (frontend=getenv("ACKFE")) ) {
+		setlist(frontend) ;
+	} else {
+		setlist(FRONTENDS);
+	}
+	setlist(machine);
+	transini();
+	scanneeds();
+	template= mktemp(ACKNAME) ;
+	if ( n_error && !k_flag ) return n_error ;
+
+	for ( n_sig=sigs ; *n_sig ; n_sig++ ) {
+		if ( signal(*n_sig,noodstop)==SIG_IGN ) {
+			signal(*n_sig,SIG_IGN) ;
+		}
+	}
+	scanlist ( l_first(arguments), elem ) {
+		if ( !process(l_content(*elem)) && !k_flag ) return 1 ;
+	}
+	orig.p_path= (char *)0 ;
+
+	if ( !combiner && !stopsuffix ) {
+		/* Call combiner directly without any transformation */
+		scanlist(l_first(tr_list),elem) {
+			if ( t_cont(*elem)->t_combine ) {
+				combiner= t_cont(*elem) ;
+			}
+		}
+	}
+
+	if ( !combiner || n_error ) return n_error ;
+
+	if ( !do_combine() ) return 1 ;
+
+	if ( g_flag ) {
+		return do_run();
+	}
+
+	return 0 ;
+}
+
+char *srcvar() {
+	return orig.p_path ;
+}
+
+varinit() {
+	/* initialize the string variables */
+	setsvar(keeps(HOME),keeps(EM_DIR)) ;
+	setpvar(keeps(SRC),srcvar)  ;
+}
+
+/************************* flag processing ***********************/
+
+vieuwargs(argc,argv) char **argv ; {
+	register char *argp;
+	register int nextarg ;
+	register int eaten ;
+
+	firstarg(argv[0]) ;
+
+	nextarg= 1 ;
+
+	while ( nextarg<argc ) {
+		argp= argv[nextarg] ;
+		nextarg++ ;
+		if ( argp[0]!='-' || argp[1]=='l' ) {
+			/* Not a flag, or a library */
+			l_add(&arguments,argp) ;
+			continue ;
+		}
+
+		/* Flags */
+		eaten=0 ; /* Did not 'eat' tail of flag yet */
+		switch ( argp[1] ) {
+	   case 'm':    if ( machine ) fuerror("Two machines?") ;
+			machine= &argp[2];
+			eaten=1 ;
+			break ;
+	   case 'o':    if ( nextarg>=argc ) {
+				fuerror("-o can't be the last flag") ;
+			}
+			if ( outfile ) fuerror("Two results?") ;
+			outfile= argv[nextarg++] ;
+			break ;
+	   case 'O':    Optflag++ ;
+			break ;
+	   case 'v':    v_flag++ ;
+			break ;
+	   case 'g':    g_flag++ ;
+			break ;
+	   case 'c':    if ( stopsuffix ) fuerror("Two -c flags") ;
+			stopsuffix= &argp[2]; eaten=1;
+			if ( *stopsuffix && *stopsuffix!=SUFCHAR ) {
+				fuerror("-c flag has invalid tail") ;
+			}
+			break ;
+	   case 'k':    k_flag++ ;
+			break ;
+	   case 't':    t_flag++ ;
+			break ;
+	   case 'R':    do_Rflag(argp); eaten=1;
+			break ;
+	   case 'r':    if ( argp[2]!=SUFCHAR ) {
+				error("-r must be followed by %c",SUFCHAR) ;
+			}
+			keeptail(&argp[2]); eaten=1 ;
+			break ;
+	   case '.':    if ( rts ) fuerror("Two run-time systems?") ;
+			rts= &argp[1] ; eaten=1;
+			keephead(rts) ; keeptail(rts) ;
+			break ;
+#ifdef DEBUG
+	   case 'd':    debug++ ;
+			break ;
+#endif
+	   case  0 :    nill_flag++ ; eaten++ ;
+			break;
+	   case 'w':    { register char *tokeep ;
+			  w_flag++;
+			  tokeep=keeps(argp) ;
+			  *tokeep |= NO_SCAN ;
+			  l_add(&flags,tokeep) ;
+			}
+			break ;
+	   default:     /* The flag is not recognized,
+			   put it on the list for the sub-processes
+			*/
+#ifdef DEBUG
+			if ( debug ) {
+				vprint("Flag %s: phase dependent\n",argp) ;
+			}
+#endif
+			l_add(&flags,keeps(argp)) ;
+			eaten=1 ;
+		}
+		if ( argp[2] && !eaten ) {
+			werror("Unexpected characters at end of %s",argp) ;
+		}
+	}
+	if ( !machine && ! (machine=getenv("ACKM")) ) {
+#ifdef ACKM
+		machine= ACKM;          /* The default machine */
+#else
+		fuerror("No machine specified") ;
+#endif
+	}
+	return ;
+}
+
+firstarg(argp) register char *argp ; {
+	register char *name ;
+
+	name=rindex(argp,'/') ;
+	if ( name && *(name+1) ) {
+		name++ ;
+	} else {
+		name= argp ;
+	}
+	if ( strcmp(name,"ack")==0 ) return ;
+	if ( strcmp(name,"acc")==0 || strcmp(name,"cc")==0 ) {
+		rts= ".c" ; keephead(rts) ; keeptail(rts) ;
+		return ;
+	}
+	if ( strcmp(name,"apc")==0 || strcmp(name,"pc")==0 ) {
+		rts= ".p" ; keephead(rts) ; keeptail(rts) ;
+		return ;
+	}
+	machine= name;
+}
+
+/************************* argument processing ***********************/
+
+process(arg) char *arg ; {
+	/* Process files & library arguments */
+	register list_elem *elem ;
+	register trf *phase ;
+	int first=YES ;
+
+#ifdef DEBUG
+	if ( debug ) vprint("Processing %s\n",arg) ;
+#endif
+	if ( arg[0]=='-' ) { l_add(&c_arguments,keeps(arg)) ; return 1 ; }
+	p_suffix= rindex(arg,SUFCHAR) ;
+	if ( p_basename ) throws(p_basename) ;
+	orig.p_keep= YES ;      /* Don't throw away the original ! */
+	orig.p_path= arg ;
+	p_basename= keeps(basename(arg)) ;
+	if ( !p_suffix ) { l_add(&c_arguments,keeps(arg)) ; return 1 ; }
+	/* Try to find a path through the transformations */
+	switch( setpath() ) {
+	case F_NOPATH :
+		error("Cannot produce the desired file from %s",arg) ;
+		l_add(&c_arguments,keeps(arg)) ;
+		return 1 ;
+	case F_NOMATCH :
+		if ( stopsuffix ) werror("Unknown suffix in %s",arg) ;
+		l_add(&c_arguments,keeps(arg)) ;
+		return 1 ;
+	case F_OK :
+		break ;
+	}
+	orig.p_keeps= NO;
+	in= orig ;
+	scanlist(l_first(tr_list), elem) {
+		phase= t_cont(*elem) ;
+		if ( phase->t_do ) { /* perform this transformation */
+			if ( first ) {
+			   if ( !nill_flag ) {
+				printf("%s\n",arg) ;
+			   }
+			}
+			switch ( phase->t_prep ) {
+			default :    if ( !mayprep() ) break ;
+			case YES:    if ( !transform(cpp_trafo) ) {
+					   n_error++ ;
+#ifdef DEBUG
+					   vprint("Pre-processor failed\n") ;
+#endif
+					   return 0 ;
+				     }
+			case NO :
+				     break ;
+			}
+			if ( cpp_trafo && stopsuffix &&
+			     strcmp(cpp_trafo->t_out,stopsuffix)==0 ) {
+				break ;
+			}
+			if ( !transform(phase) ) {
+				n_error++ ;
+#ifdef DEBUG
+				if ( debug ) {
+					vprint("phase %s for %s failed\n",
+					       phase->t_name,orig.p_path) ;
+				}
+#endif
+				return 0 ;
+			}
+			first=NO ;
+		}
+	}
+#ifdef DEBUG
+	if ( debug ) vprint("Transformation complete for %s\n",orig.p_path) ;
+#endif
+	if ( !in.p_keep ) fatal("attempt to discard the result file") ;
+	l_add(&c_arguments,keeps(in.p_path));
+	disc_files() ;
+	return 1 ;
+}
+
+mayprep() {
+	int file ;
+	char fc ;
+	file=open(in.p_path,0);
+	if ( file<0 ) return 0 ;
+	if ( read(file,&fc,1)!=1 ) fc=0 ;
+	close(file) ;
+	return fc=='#' ;
+}
+
+keephead(suffix) char *suffix ; {
+	l_add(&head_list, suffix) ;
+}
+
+keeptail(suffix) char *suffix ; {
+	l_add(&tail_list, suffix) ;
+}
+
+scanneeds() {
+	register list_elem *elem ;
+	scanlist(l_first(head_list), elem) { setneeds(l_content(*elem),0) ; }
+	l_clear(&head_list) ;
+	scanlist(l_first(tail_list), elem) { setneeds(l_content(*elem),1) ; }
+	l_clear(&tail_list) ;
+}
+
+setneeds(suffix,tail) char *suffix ; {
+	register list_elem *elem ;
+	register trf *phase ;
+
+	p_suffix= suffix ;
+	switch ( setpath() ) {
+	case F_OK :
+		scanlist( l_first(tr_list), elem ) {
+			phase = t_cont(*elem) ;
+			if ( phase->t_do ) {
+				if ( phase->t_needed ) {
+					if ( tail )
+						add_tail(phase->t_needed) ;
+					else
+						add_head(phase->t_needed) ;
+				}
+			}
+		}
+		break ;
+	case F_NOMATCH :
+		werror("\"%s\": unrecognized suffix",suffix) ;
+		break ;
+	case F_NOPATH :
+		werror("incomplete internal specification for %s files",
+			suffix) ;
+		break ;
+	}
+}

+ 208 - 0
util/ack/malloc.c

@@ -0,0 +1,208 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+
+#include "ack.h"
+#ifdef DEBUG
+#define ASSERT(p) if(!(p))botch("p");else
+botch(s)
+char *s;
+{
+	printf("malloc/free botched: %s\n",s);
+	abort();
+}
+#else
+#define ASSERT(p)
+#endif
+
+/*      avoid break bug */
+#ifdef pdp11
+#define GRANULE 64
+#else
+#define GRANULE 0
+#endif
+/*      C storage allocator
+ *      circular first-fit strategy
+ *      works with noncontiguous, but monotonically linked, arena
+ *      each block is preceded by a ptr to the (pointer of)
+ *      the next following block
+ *      blocks are exact number of words long
+ *      aligned to the data type requirements of ALIGN
+ *      pointers to blocks must have BUSY bit 0
+ *      bit in ptr is 1 for busy, 0 for idle
+ *      gaps in arena are merely noted as busy blocks
+ *      last block of arena (pointed to by alloct) is empty and
+ *      has a pointer to first
+ *      idle blocks are coalesced during space search
+ *
+ *      a different implementation may need to redefine
+ *      ALIGN, NALIGN, BLOCK, BUSY, INT
+ *      where INT is integer type to which a pointer can be cast
+*/
+#define INT int
+#define ALIGN int
+#define NALIGN 1
+#define WORD sizeof(union store)
+#define BLOCK 1024      /* a multiple of WORD*/
+#define BUSY 1
+#define NULL 0
+#define testbusy(p) ((INT)(p)&BUSY)
+#define setbusy(p) (union store *)((INT)(p)|BUSY)
+#define clearbusy(p) (union store *)((INT)(p)&~BUSY)
+
+union store { union store *ptr;
+	      ALIGN dummy[NALIGN];
+	      int calloc;       /*calloc clears an array of integers*/
+};
+
+static  union store allocs[2];  /*initial arena*/
+static  union store *allocp;    /*search ptr*/
+static  union store *alloct;    /*arena top*/
+static  union store *allocx;    /*for benefit of realloc*/
+char    *sbrk();
+
+char *
+malloc(nbytes)
+unsigned nbytes;
+{
+	register union store *p, *q;
+	register nw;
+	static temp;    /*coroutines assume no auto*/
+
+	if(allocs[0].ptr==0) {  /*first time*/
+		allocs[0].ptr = setbusy(&allocs[1]);
+		allocs[1].ptr = setbusy(&allocs[0]);
+		alloct = &allocs[1];
+		allocp = &allocs[0];
+	}
+	nw = (nbytes+WORD+WORD-1)/WORD;
+	ASSERT(allocp>=allocs && allocp<=alloct);
+	ASSERT(allock());
+	for(p=allocp; ; ) {
+		for(temp=0; ; ) {
+			if(!testbusy(p->ptr)) {
+				while(!testbusy((q=p->ptr)->ptr)) {
+					ASSERT(q>p&&q<alloct);
+					p->ptr = q->ptr;
+				}
+				if(q>=p+nw && p+nw>=p)
+					goto found;
+			}
+			q = p;
+			p = clearbusy(p->ptr);
+			if(p>q)
+				ASSERT(p<=alloct);
+			else if(q!=alloct || p!=allocs) {
+				ASSERT(q==alloct&&p==allocs);
+				return(NULL);
+			} else if(++temp>1)
+				break;
+		}
+		temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD);
+		q = (union store *)sbrk(0);
+		if(q+temp+GRANULE < q) {
+			return(NULL);
+		}
+		q = (union store *)sbrk(temp*WORD);
+		if((INT)q == -1) {
+			return(NULL);
+		}
+		ASSERT(q>alloct);
+		alloct->ptr = q;
+		if(q!=alloct+1)
+			alloct->ptr = setbusy(alloct->ptr);
+		alloct = q->ptr = q+temp-1;
+		alloct->ptr = setbusy(allocs);
+	}
+found:
+	allocp = p + nw;
+	ASSERT(allocp<=alloct);
+	if(q>allocp) {
+		allocx = allocp->ptr;
+		allocp->ptr = p->ptr;
+	}
+	p->ptr = setbusy(allocp);
+	return((char *)(p+1));
+}
+
+/*      freeing strategy tuned for LIFO allocation
+*/
+free(ap)
+register char *ap;
+{
+	register union store *p = (union store *)ap;
+
+	ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct);
+	ASSERT(allock());
+	allocp = --p;
+	ASSERT(testbusy(p->ptr));
+	p->ptr = clearbusy(p->ptr);
+	ASSERT(p->ptr > allocp && p->ptr <= alloct);
+}
+
+/*      realloc(p, nbytes) reallocates a block obtained from malloc()
+ *      and freed since last call of malloc()
+ *      to have new size nbytes, and old content
+ *      returns new location, or 0 on failure
+*/
+
+char *
+realloc(p, nbytes)
+register union store *p;
+unsigned nbytes;
+{
+	register union store *q;
+	union store *s, *t;
+	register unsigned nw;
+	unsigned onw;
+
+	if(testbusy(p[-1].ptr))
+		free((char *)p);
+	onw = p[-1].ptr - p;
+	q = (union store *)malloc(nbytes);
+	if(q==NULL || q==p)
+		return((char *)q);
+	s = p;
+	t = q;
+	nw = (nbytes+WORD-1)/WORD;
+	if(nw<onw)
+		onw = nw;
+	while(onw--!=0)
+		*t++ = *s++;
+	if(q<p && q+nw>=p)
+		(q+(q+nw-p))->ptr = allocx;
+	return((char *)q);
+}
+
+#ifdef DEBUG
+allock()
+{
+#ifdef DEBUG
+	register union store *p;
+	int x;
+	x = 0;
+	for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) {
+		if(p==allocp)
+			x++;
+	}
+	ASSERT(p==alloct);
+	return(x==1|p==allocp);
+#else
+	return(1);
+#endif
+}
+#endif

+ 121 - 0
util/ack/mktables.c

@@ -0,0 +1,121 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+
+char *fname = 0 ;
+char dname[200] ;
+char *tail ;
+
+FILE *intab ;
+FILE *dmach ;
+
+int index ;
+
+main(argc,argv) char **argv ; {
+	register i ;
+
+	start(argv[1]) ;
+	for ( i=2 ; i<argc ; i++ ) {
+		fname= argv[i] ;
+		readm() ;
+	}
+	stop(argc>2) ;
+	return 0 ;
+}
+
+start(dir) char *dir ; {
+	tail= dname ;
+	while ( *dir ) {
+		*tail++ = *dir ++ ;
+	}
+	if ( tail!=dname ) *tail++= '/' ;
+	index=0 ;
+	intab= fopen("intable.c","w");
+	dmach= fopen("dmach.c","w");
+	if ( intab==NULL || dmach==NULL ) {
+		fprintf(stderr,"Couln't create output file(s)\n");
+		exit ( 1) ;
+	}
+	fprintf(dmach,"#include \"dmach.h\"\n\ndmach\tmassoc[] = {\n") ;
+	fprintf(intab,"char intable[] = {\n") ;
+}
+
+stop(filled) {
+	fprintf(dmach,"\t{\"\",\t-1\t}\n} ;\n") ;
+	if ( !filled ) fprintf(intab,"\t0\n") ;
+	fprintf(intab,"\n} ;\n") ;
+	fclose(dmach); fclose(intab) ;
+}
+
+FILE *do_open(file) char *file ; {
+	strcpy(tail,file) ;
+	return fopen(dname,"r") ;
+}
+
+readm() {
+	register int i ;
+	register int token ;
+	register FILE *in ;
+
+	in=do_open(fname) ;
+	if ( in==NULL ) {
+		fprintf(stderr,"Cannot open %s\n",fname) ;
+		return ;
+	}
+	i=0 ;
+	fprintf(dmach,"\t{\"%s\",\t%d\t},\n",fname,index) ;
+	fprintf(intab,"\n/* %s */\n\t",fname) ;
+	for (;;) {
+		token=getc(in) ;
+		index++ ;
+		if ( ++i == 10 ) {
+			fprintf(intab,"\n\t") ;
+			i=0 ;
+		} else {
+			fprintf(intab," ") ;
+		}
+		if ( !isascii(token) || !(isprint(token) || isspace(token)) ){
+			if ( token!=EOF ) {
+			  fprintf(stderr,"warning: non-ascii in %s\n",fname) ;
+			  fprintf(intab,"%4d,",token) ;
+			} else {
+			  fprintf(intab,"  0,",token) ;
+			  break ;
+			}
+		} else if ( isprint(token) ) {
+			switch ( token ) {
+			case '\'': fprintf(intab,"'\\''") ; break ;
+			case '\\': fprintf(intab,"'\\\\'") ; break ;
+			default:   fprintf(intab," '%c'",token) ; break ;
+			}
+		} else switch ( token ) {
+		case '\n' : fprintf(intab,"'\\n'") ; break ;
+		case '\t' : fprintf(intab,"'\\t'") ; break ;
+		case '\r' : fprintf(intab,"'\\r'") ; break ;
+		case '\f' : fprintf(intab,"'\\f'") ; break ;
+		case ' '  : fprintf(intab," ' '")  ; break ;
+		default :   fprintf(stderr,"warning: unrec. %d\n",
+				token) ;
+			    fprintf(intab,"%4d",token) ;
+			    break ;
+		}
+		fprintf(intab,",") ;
+	}
+	fclose(in) ;
+}

+ 2 - 0
util/ack/pc/.distr

@@ -0,0 +1,2 @@
+Makefile
+em_pc.c

+ 25 - 0
util/ack/pc/Makefile

@@ -0,0 +1,25 @@
+d=../../..
+h=$d/h
+
+PC_PATH=$d/lib/em_pc
+
+em_pc:          em_pc.c $h/local.h $h/em_path.h
+		cc -n -o em_pc -O -I$h em_pc.c
+
+cmp:            em_pc
+		cmp em_pc $(PC_PATH)
+
+install:        em_pc
+		cp em_pc $(PC_PATH)
+
+lint:
+		lint -hpxc -I$h em_pc.c
+
+clean:
+		rm -f *.o *.old em_pc
+
+opr:
+		make pr ^ opr
+
+pr:
+		pr -n em_pc.c

+ 681 - 0
util/ack/pc/em_pc.c

@@ -0,0 +1,681 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/*
+ * put all the pieces of the pascal part of the EM project together
+ *      original author: Johan Stevenson, Vrije Universiteit, Amsterdam
+ *      heavily modified by: Ed Keizer, Vrije Universiteit, Amsterdam
+ */
+
+#include        <stdio.h>
+#include        <signal.h>
+#include        <sys/types.h>
+#include        <sys/dir.h>
+#include        <em_path.h>
+#include        <pc_size.h>
+#include        <local.h>
+
+#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<no_pemflag ; i++ ) fprintf(erfil,"%s\n",pemflag[i]);
+	fclose(erfil);
+	*v++ = q;
+	*v++ = d;
+	call(v,p,(char *)0);
+	if (toterr == 0)
+		if (list(p,d) < 0)
+			toterr++;
+	donewith(d);
+}
+
+/* ------------------- miscellaneous routines --------------- */
+
+char *basename(p) char *p; {
+	register char *q;
+
+	q = p;
+	while (*q)
+		if (*q++ == '/')
+			p = q;
+	return(p);
+}
+
+char *tempfile(suf) {
+	register char *p,*q;
+	register i;
+
+	p = charp; q = tmp_dir;
+	while (*p = *q++)
+		p++;
+	*p++ = '/';
+	q = unique;
+	while (*p = *q++)
+		p++;
+	i = fileargs;
+	do
+		*p++ = i % 10 + '0';
+	while (i /= 10);
+	*p++ = '.'; *p++ = suf; *p++ = '\0';
+	q = charp; charp = p;
+	return(q);
+}
+
+call(v,in,out) char **v,*in,*out; {
+	register pid;
+	int     status;
+
+	while ((parent = fork()) < 0)
+		sleep(1);
+	if (parent == 0) {
+		if (in) {
+			close(0);
+			if (open(in,0) != 0)
+				syserr(in);
+		}
+		if (out) {
+			close(1);
+			if (creat(out,0666) != 1)
+				syserr(out);
+		}
+		*v = 0;
+		execv(callvector[0],callvector+1);
+		syserr(callvector[0]);
+	}
+	while ((pid = wait(&status)) != parent) {
+		if (pid == -1)
+			fatal("process %d disappeared",parent);
+		fatal("unknown child %d died",pid);
+	}
+	if ((status & 0177) > 3) {
+/*
+		if ((status & 0200) && tflag==0)
+			unlink("core");
+*/
+		fatal("signal %d in %s. Ask an expert for help",
+				status&0177,callvector[0]);
+	}
+	if (status & 0177400)
+		toterr++;
+}
+
+char **initvector(path) char *path; {
+	register char *p,**v;
+
+	v = callvector;
+	p = path;
+	*v++ = p;
+	*v++ = basename(p);
+	return(v);
+}
+
+finish() {
+	register char *p,*q;
+	register fd;
+	struct direct dir;
+
+	signal(SIGINT,SIG_IGN);
+	if (parent != 0) {
+		chdir(tmp_dir);
+		fd = open(".",0);
+		while (read(fd,(char *) &dir,sizeof dir) == sizeof dir) {
+			if (dir.d_ino == 0)
+				continue;
+			p = unique;
+			q = dir.d_name;
+			while (*p++ == *q++)
+				if (*p == '\0') {
+					unlink(dir.d_name);
+					break;
+				}
+		}
+		close(fd);
+	}
+	exit(toterr ? -1 : 0);
+}
+
+
+donewith(p) char *p; {
+
+	if (p >= charbuf && p < &charbuf[CHARSIZE])
+		unlink(p);
+}
+
+init() {
+	register char *p;
+	register i,fd;
+
+	if ((fd = open(tmp_dir,0)) < 0)
+		tmp_dir = ".";
+	close(fd);
+	p = unique+2;
+	parent = i = getpid();
+	do
+		*p++ = i % 10 + '0';
+	while (i /= 10);
+	*p++ = '.'; *p = '\0';
+}
+
+/* ------------------- pascal listing ----------------------- */
+
+#define MAXERNO         300
+#define MAXERRLIST      10
+#define IDMAX           8
+
+struct errec {
+	int     erno;
+	char    mess[IDMAX+1];
+	int     mesi;
+	int     chno;
+	int     lino;
+};
+
+struct  errec   curr;
+struct  errec   next;
+
+int     *index          = 0;
+int     maxerno;
+
+int     errerr;
+int     errfat;
+
+int     listlino;
+int     listorig;
+int     listrela;
+char    *listfnam;
+
+FILE    *inpfil;
+FILE    *mesfil;
+FILE    *errfil;
+
+int     errorline();
+int     geterrec();
+int     nexterror();
+
+int list(p,q) char *p,*q; {
+
+	if ((errfil = fopen(q,"r")) == NULL)
+		syserr(q);
+	if (geterrec() == 0)
+		if (eeflag==0) {
+			fclose(errfil);
+			return(0);
+		}
+	if (index == 0) {
+		index = (int *) sbrk(MAXERNO * sizeof index[0]);
+		fillindex();
+	}
+	if ((inpfil = fopen(p,"r")) == NULL)
+		syserr(p);
+	errerr = 0;
+	errfat = 0;
+	listlino = 0;
+	listorig = 0;
+	listrela = 0;
+	listfnam = source;
+	if (eeflag)
+		listfull();
+	else if (eflag)
+		listpartial();
+	else
+		listshort();
+	fclose(errfil);
+	fclose(inpfil);
+	fflush(stdout);
+	return(errfat ? -1 : 1);
+}
+
+listshort() {
+
+	while (nexterror()) {
+		while (listlino < curr.lino)
+			nextline(0);
+		printf("%s, line %d: ",listfnam,listrela);
+		string(&curr);
+	}
+}
+
+listfull() {
+
+	if (nexterror())
+		do {
+			do {
+				nextline(1);
+			} while (listlino < curr.lino);
+		} while (errorline());
+	while (nextline(1))
+		;
+}
+
+listpartial() {
+
+	if (nexterror())
+		do {
+			do {
+				nextline(listlino >= curr.lino-2);
+			} while (listlino < curr.lino);
+		} while (errorline());
+}
+
+int nextline(printing) {
+	register ch;
+
+	listlino++;
+	ch = getc(inpfil);
+	if (ch == '#') {
+		if (lineline(printing) == 0)
+			fatal("bad line directive");
+		return(1);
+	}
+	listrela++;
+	if (listfnam == source)
+		listorig++;
+	if (ch != EOF) {
+		if (printing)
+			printf("%5d\t",listorig);
+		do {
+			if (printing)
+				putchar(ch);
+			if (ch == '\n')
+				return(1);
+		} while ((ch = getc(inpfil)) != EOF);
+	}
+	return(0);
+}
+
+lineline(printing) {
+	register ch;
+	register char *p,*q;
+	static char line[100];
+
+	p = line;
+	while ((ch = getc(inpfil)) != '\n') {
+		if (ch == EOF || p == &line[100-1])
+			return(0);
+		*p++ = ch;
+	}
+	*p = '\0'; p = line;
+	if (printing)
+		printf("\t#%s\n",p);
+	if ((listrela = atoi(p)-1) < 0)
+		return(0);
+	while ((ch = *p++) != '"')
+		if (ch == '\0')
+			return(0);
+	q = p;
+	while (ch = *p++) {
+		if (ch == '"') {
+			*--p = '\0';
+			if ( source ) {
+				listfnam = strcmp(q,source)==0 ? source : q;
+				return(1);
+			}
+			source=q ; listfnam=q ;
+			return 1 ;
+		}
+		if (ch == '/')
+			q = p;
+	}
+	return(0);
+}
+
+int errorline() {
+	register c;
+	register struct errec *p,*q;
+	struct  errec   lerr[MAXERRLIST];
+	int     goon;
+
+	printf("*** ***");
+	p = lerr;
+	c = 0;
+	do {
+		if (c < curr.chno) {
+			printf("%*c",curr.chno-c,'^');
+			c = curr.chno;
+		}
+		if (p < &lerr[MAXERRLIST])
+			*p++ = curr;
+		goon = nexterror();
+	} while (goon && curr.lino==listlino);
+	putchar('\n');
+	for (q = lerr; q < p; q++)
+		string(q);
+	putchar('\n');
+	return(goon);
+}
+
+int geterrec() {
+	register ch;
+	register char *p;
+
+	ch = getc(errfil);
+	next.erno = 0;
+	next.mesi = -1;
+	next.mess[0] = '\0';
+	if (ch == EOF)
+		return(0);
+	if (ch >= '0' && ch <= '9') {
+		ch = getnum(ch,&next.mesi);
+	} else if (ch == '\'') {
+		p = next.mess;
+		while ((ch = getc(errfil)) != ' ' && ch != EOF)
+			if (p < &next.mess[IDMAX])
+				*p++ = ch;
+		*p = '\0';
+	}
+	ch = getnum(ch, &next.erno);
+	ch = getnum(ch, &next.lino);
+	ch = getnum(ch, &next.chno);
+	if (ch != '\n')
+		fatal("bad error line");
+	return(1);
+}
+
+int getnum(ch, ip) register ch; register *ip; {
+	register neg;
+
+	*ip = 0;
+	while (ch == ' ')
+		ch = getc(errfil);
+	if (neg = ch=='-')
+		ch = getc(errfil);
+	while (ch >= '0' && ch <= '9') {
+		*ip = *ip * 10 - '0' + ch;
+		ch = getc(errfil);
+	}
+	if (neg)
+		*ip = -(*ip);
+	return(ch);
+}
+
+int nexterror() {
+
+	do {    /* skip warnings if wflag */
+		curr = next;
+		if (curr.erno == 0)
+			return(0);
+		for (;;) {
+			if (geterrec() == 0)
+				break;
+			if (next.lino != curr.lino || next.chno != curr.chno)
+				break;
+			if (curr.erno < 0 && next.erno > 0)
+				/* promote warnings if they cause fatals */
+				curr.erno = -curr.erno;
+			if (next.mess[0] != '\0' || next.mesi != -1)
+				/* give all parameterized errors */
+				break;
+			if (curr.mess[0] != '\0' || curr.mesi != -1)
+				/* and at least a non-parameterized one */
+				break;
+		}
+	} while (curr.erno < 0 && wflag != 0);
+	return(1);
+}
+
+fillindex() {
+	register *ip,n,c;
+
+	if ((mesfil = fopen(err_path,"r")) == NULL)
+		syserr(err_path);
+	ip = index;
+	*ip++ = 0;
+	n = 0;
+	while ((c = getc(mesfil)) != EOF) {
+		n++;
+		if (c == '\n') {
+			*ip++ = n;
+			if (ip > &index[MAXERNO])
+				fatal("too many errors on %s",err_path);
+		}
+	}
+	maxerno = ip - index;
+}
+
+string(ep) register struct errec *ep; {
+	register i,n;
+
+	errerr++;
+	if ((i = ep->erno) < 0) {
+		i = -i;
+		printf("Warning: ");
+	} else
+		errfat++;
+	if (i == 0 || i >= maxerno)
+		fatal("bad error number %d",i);
+	n = index[i] - index[i-1];
+	fseek(mesfil,(long)index[i-1],0);
+	while (--n >= 0) {
+		i = getc(mesfil);
+		if (i == '%' && --n>=0) {
+			i = getc(mesfil);
+			if (i == 'i')
+				printf("%d", ep->mesi);
+			else if (i == 's')
+				printf("%s", ep->mess);
+			else
+				putchar(i);
+		} else
+			putchar(i);
+	}
+}
+
+/* ------------------- error routines -------------------------- */
+
+/* VARARGS1 */
+void ermess(s,a1,a2,a3,a4) char *s; {
+
+	fprintf(stderr,"%s: ",progname);
+	fprintf(stderr,s,a1,a2,a3,a4);
+	fprintf(stderr,"\n");
+}
+
+syserr(s) char *s; {
+	fatal("%s: %s",s,sys_errlist[errno]);
+}
+
+/* VARARGS1 */
+void fatal(s,a1,a2,a3,a4) char *s; {
+
+	ermess(s,a1,a2,a3,a4);
+	toterr++;
+	finish();
+}

+ 154 - 0
util/ack/run.c

@@ -0,0 +1,154 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "list.h"
+#include "trans.h"
+#include "data.h"
+#include <signal.h>
+
+#define ARG_MORE  40            /* The size of args chunks to allocate */
+
+static char      **arglist ;    /* The first argument */
+static unsigned  argcount ;     /* The current number of arguments */
+static unsigned  argmax;        /* The maximum number of arguments so far */
+
+int do_run() {
+	fatal("-g flag not implemeted") ;
+	/*NOTREACHED*/
+	return 0 ;
+}
+
+int runphase(phase) register trf *phase ; {
+	register list_elem *elem ;
+
+	if ( v_flag || debug ) {
+		if ( v_flag==1 && !debug ) {
+			vprint("%s",phase->t_name) ;
+			if ( !phase->t_combine ) {
+				vprint(" %s%s\n",p_basename,
+					rindex(in.p_path,SUFCHAR) ) ;
+			} else {
+				scanlist(l_first(c_arguments), elem) {
+					vprint(" %s",l_content(*elem)) ;
+				}
+				vprint("\n") ;
+			}
+		} else {
+			/* list all args */
+			vprint("%s",phase->t_prog) ;
+			scanlist(l_first(phase->t_flags), elem) {
+				vprint(" %s",l_content(*elem)) ;
+			}
+			scanlist(l_first(phase->t_args), elem) {
+				vprint(" %s",l_content(*elem)) ;
+			}
+			vprint("\n") ;
+		}
+	}
+	argcount=0 ;
+	x_arg(phase->t_name) ;
+	scanlist(l_first(phase->t_flags), elem) {
+		x_arg(l_content(*elem)) ;
+	}
+	scanlist(l_first(phase->t_args), elem) {
+		x_arg(l_content(*elem)) ;
+	}
+	x_arg( (char *)0 ) ;
+	return run_exec(phase) ;
+}
+
+int run_exec(phase) trf *phase ; {
+	int status, child, waitchild ;
+
+	do_flush();
+	while ( (child=fork())== -1 ) ;
+	if ( child ) {
+		/* The parent */
+		do {
+			waitchild= wait(&status) ;
+			if ( waitchild== -1 ) {
+				fatal("missing child") ;
+			}
+		} while ( waitchild!=child) ;
+		if ( status ) {
+			if ( status&0200 && (status&0177)!=SIGQUIT &&
+				!t_flag ) unlink("core") ;
+			switch ( status&0177 ) {
+			case 0 :
+				break ;
+			case SIGHUP:
+			case SIGINT:
+			case SIGQUIT:
+			case SIGTERM:
+				quit(-5) ;
+			default:
+				error("%s died with signal %d",
+					phase->t_prog,status&0177) ;
+			}
+			/* The assumption is that processes voluntarely
+			   dying with a non-zero status already produced
+			   some sort of error message to the outside world.
+			*/
+			n_error++ ;
+			return 0 ;
+		}
+		return 1 ; /* From the parent */
+	}
+	/* The child */
+	if ( phase->t_stdin ) {
+		if ( !in.p_path ) {
+			fatal("no input file for %s",phase->t_name) ;
+		}
+		close(0) ;
+		if ( open(in.p_path,0)!=0 ) {
+			error("cannot open %s",in.p_path) ;
+			exit(1) ;
+		}
+	}
+	if ( phase->t_stdout ) {
+		if ( !out.p_path ) {
+			fatal("no output file for %s",phase->t_name) ;
+		}
+		close(1) ;
+		if ( creat(out.p_path,0666)!=1 ) {
+			close(1); dup(2);
+			error("cannot open %s",out.p_path) ;
+			exit(1) ;
+		}
+	}
+	execv(phase->t_prog,arglist) ;
+	if ( phase->t_stdout ) { close(1) ; dup(2) ; }
+	error("Cannot execute %s",phase->t_prog) ;
+	exit(1) ;
+	/*NOTREACHED*/
+}
+
+x_arg(string) char *string ; {
+	/* Add one execute argument to the argument vector */
+	if ( argcount==argmax ) {
+		if ( argmax==0 ) {
+			argmax= 2*ARG_MORE ;
+			arglist= (char **)getcore(argmax*sizeof (char *)) ;
+		} else {
+			argmax += ARG_MORE ;
+			arglist= (char **)changecore((char *)arglist,
+					argmax*sizeof (char *)) ;
+		}
+	}
+	*(arglist+argcount++) = string ;
+}

+ 244 - 0
util/ack/scan.c

@@ -0,0 +1,244 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "list.h"
+#include "trans.h"
+#include "data.h"
+
+enum f_path setpath() { /* Try to find a transformation path */
+
+	start_scan();
+	/*
+		The end result is the setting of the t_do flags
+		in the transformation list.
+		The list is scanned for possible transformations
+		stopping at stopsuffix or a combine transformation.
+		The scan flags are set by this process.
+		When a transformation is found, it is compared with
+		the last transformation found, if better (or the first)
+		the scan bits are copied to the t_do bits, except for
+		the combiner which is remembered in a global pointer.
+		At the end of all transformations for all files, the combiner
+		is called, unless errors occurred.
+	*/
+	try(l_first(tr_list),p_suffix);
+	return scan_end();
+}
+
+/******************** data used only while scanning *******************/
+
+static  int     last_ncount;    /* The # of non-optimizing transformations
+				   in the best path sofar */
+
+static  int     last_ocount;    /* The # of optimizing transformations in the
+				   best path sofar */
+static  int     com_err;        /* Complain only once about multiple linkers*/
+
+static  trf     *final;         /* The last non-combining transformation */
+
+static  int     suf_found;      /* Was the suffix at least recognized ? */
+
+/********************       The hard work          ********************/
+
+start_scan() {
+	register list_elem *scan ;
+
+	scanlist(l_first(tr_list),scan) {
+		t_cont(*scan)->t_do=NO ; t_cont(*scan)->t_scan=NO ;
+		t_cont(*scan)->t_keep=NO ;
+	}
+	final= (trf *)0 ;
+	suf_found= 0 ;
+#ifdef DEBUG
+	if ( debug>=3 ) vprint("Scan_start\n");
+#endif
+	last_ncount= -1 ;
+	last_ocount= 0 ;
+}
+
+try(f_scan,suffix) list_elem *f_scan; char *suffix; {
+	register list_elem *scan ;
+	register trf  *trafo ;
+	/* Try to find a transformation path starting at f_scan for a
+	   file with the indicated suffix.
+	   If the suffix is already reached or the combiner is found
+	   call scan_found() to OK the scan.
+	   If a transformation is found it calls itself recursively
+	   with as starting point the next transformation in the list.
+	*/
+	if ( stopsuffix && *stopsuffix && strcmp(stopsuffix,suffix)==0 ) {
+		scan_found();
+		return ;
+	}
+	scanlist(f_scan, scan) {
+		trafo= t_cont(*scan) ;
+		if ( satisfy(trafo,suffix) ) {
+			/* Found a transformation */
+			suf_found= 1;
+#ifdef DEBUG
+			if ( debug>=4 ) {
+				vprint("Found %s for %s: result %s\n",
+				       trafo->t_name,suffix,trafo->t_out);
+			}
+#endif
+			trafo->t_scan=YES ;
+			if ( trafo->t_prep ) {
+				if ( !cpp_trafo ) {
+					find_cpp() ;
+				}
+				if ( stopsuffix &&
+				     strcmp(stopsuffix,
+					cpp_trafo->t_out)==0 )
+				{
+					scan_found() ;
+					return ;
+				}
+			}
+			if ( trafo->t_combine ) {
+				if ( stopsuffix ) {
+					trafo->t_scan=NO;
+					if ( *stopsuffix ) return ;
+				} else {
+					if( combiner &&
+					    combiner!=trafo && !com_err ){
+					       com_err++ ;
+werror("Multiple linkers present %s and %s",
+	trafo->t_name,combiner->t_name) ;
+					} else {
+						combiner=trafo;
+					}
+				}
+				scan_found() ;
+			} else {
+				try(l_next(*scan),trafo->t_out);
+			}
+			trafo->t_scan= NO ;
+		}
+	}
+}
+
+scan_found() {
+	register list_elem *scan;
+	int ncount, ocount ;
+	register trf *keepit ;
+
+	keepit= (trf *)0 ;
+	suf_found= 1;
+#ifdef DEBUG
+	if ( debug>=3 ) vprint("Scan found\n") ;
+#endif
+	/* Gather data used in comparison */
+	ncount=0; ocount=0;
+	scanlist(l_first(tr_list),scan) {
+		if (t_cont(*scan)->t_scan) {
+#ifdef DEBUG
+			if ( debug>=4 ) vprint("%s-",t_cont(*scan)->t_name) ;
+#endif
+			if( t_cont(*scan)->t_optim ) ocount++ ;else ncount++ ;
+			if ( !(t_cont(*scan)->t_combine) ) {
+				keepit= t_cont(*scan) ;
+			}
+		}
+	}
+#ifdef DEBUG
+	if ( debug>=4 ) vprint("\n");
+#endif
+	/* Is this transformation better then any found yet ? */
+#ifdef DEBUG
+	if ( debug>=3 ) {
+		vprint("old n:%d, o:%d - new n:%d, o:%d\n",
+			last_ncount,last_ocount,ncount,ocount) ;
+	}
+#endif
+	if ( last_ncount== -1 ||                /* None found yet */
+	     last_ncount>ncount ||              /* Shorter nec. path */
+	     (last_ncount==ncount &&            /* Same nec. path, optimize?*/
+		(Optflag? last_ocount<ocount : last_ocount>ocount ) ) ) {
+		/* Yes it is */
+#ifdef DEBUG
+		if ( debug>=3 ) vprint("Better\n");
+#endif
+		scanlist(l_first(tr_list),scan) {
+			t_cont(*scan)->t_do=t_cont(*scan)->t_scan;
+		}
+		last_ncount=ncount; last_ocount=ocount;
+		if ( keepit ) final=keepit ;
+	}
+}
+
+int satisfy(trafo,suffix) register trf *trafo; char *suffix ; {
+	register char *f_char, *l_char ;
+	/* Check whether this transformation is present for
+	   the current machine and the parameter suffix is among
+	   the input suffices. If so, return 1. 0 otherwise
+	*/
+	if ( trafo->t_isprep ) return 0 ;
+	l_char=trafo->t_in ;
+	while ( l_char ) {
+		f_char= l_char ;
+		if ( *f_char!=SUFCHAR || ! *(f_char+1) ) {
+			fuerror("Illegal input suffix entry for %s",
+				trafo->t_name) ;
+		}
+		l_char=index(f_char+1,SUFCHAR);
+		if ( l_char ? strncmp(f_char,suffix,l_char-f_char)==0 :
+			      strcmp(f_char,suffix)==0 ) {
+			return 1 ;
+		}
+	}
+	return 0 ;
+}
+
+enum f_path scan_end() {    /* Finalization */
+	/* Return value indicating whether a transformation was found */
+	/* Set the flags for the transformation up to, but not including,
+	   the combiner
+	*/
+
+#ifdef DEBUG
+	if ( debug>=3 ) vprint("End_scan\n");
+#endif
+	if ( last_ncount== -1 ) return suf_found ? F_NOPATH : F_NOMATCH ;
+#ifdef DEBUG
+	if ( debug>=2 ) vprint("Transformation found\n");
+#endif
+	if ( cpp_trafo && stopsuffix &&
+	     strcmp(stopsuffix,cpp_trafo->t_out)==0 ) {
+		final= cpp_trafo ;
+	}
+	/* There might not be a final when the file can be eaten
+	   by the combiner
+	*/
+	if ( final ) final->t_keep=YES ;
+	if ( combiner ) {
+		if ( !combiner->t_do ) error("Combiner YES/NO");
+		combiner->t_do=NO ;
+	}
+	return F_OK ;
+}
+
+find_cpp() {
+	register list_elem *elem ;
+	scanlist( l_first(tr_list), elem ) {
+		if ( t_cont(*elem)->t_isprep ) {
+			if ( cpp_trafo ) fuerror("Multiple cpp's present") ;
+			cpp_trafo= t_cont(*elem) ;
+		}
+	}
+	if ( !cpp_trafo ) fuerror("No cpp present") ;
+}

+ 125 - 0
util/ack/svars.c

@@ -0,0 +1,125 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+
+/*      The processing of string valued variables,
+	this is an almost self contained module.
+
+	Five externally visible routines:
+
+	setsvar(name,result)
+		Associate the name with the result.
+
+		name    a string pointer
+		result  a string pointer
+
+	setpvar(name,routine)
+		Associate the name with the routine.
+
+		name    a string pointer
+		routine a routine id
+
+	   The parameters name and result are supposed to be pointing to
+	   non-volatile string storage used only for this call.
+
+	char *getvar(name)
+		returns the pointer to a string associated with name,
+		the pointer is produced by returning result or the
+		value returned by calling the routine.
+
+		name    a string pointer
+
+	Other routines called
+
+	fatal(args*)    When something goes wrong
+	getcore(size)   Core allocation
+
+*/
+
+extern  char    *getcore();
+extern          fatal();
+
+struct vars {
+	char                            *v_name;
+	enum { routine, string }        v_type;
+
+	union {
+		char    *v_string;
+		char    *(*v_routine)();
+	}                               v_value ;
+	struct vars                     *v_next ;
+};
+
+static struct vars *v_first ;
+
+static struct vars *newvar(name) char *name; {
+	register struct vars *new ;
+
+	for ( new=v_first ; new ; new= new->v_next ) {
+		if ( strcmp(name,new->v_name)==0 ) {
+			throws(name) ;
+			if ( new->v_type== string ) {
+				throws(new->v_value.v_string) ;
+			}
+			return new ;
+		}
+	}
+	new= (struct vars *)getcore( (unsigned)sizeof (struct vars));
+	new->v_name= name ;
+	new->v_next= v_first ;
+	v_first= new ;
+	return new ;
+}
+
+setsvar(name,str) char *name, *str ; {
+	register struct vars *new ;
+
+	new= newvar(name);
+#ifdef DEBUG
+	if ( debug>=2 ) vprint("%s=%s\n", name, str) ;
+#endif
+	new->v_type= string;
+	new->v_value.v_string= str;
+}
+
+setpvar(name,rout) char *name, *(*rout)() ; {
+	register struct vars *new ;
+
+	new= newvar(name);
+#ifdef DEBUG
+	if ( debug>=2 ) vprint("%s= (*%o)()\n",name,rout) ;
+#endif
+	new->v_type= routine;
+	new->v_value.v_routine= rout;
+}
+
+char *getvar(name) char *name ; {
+	register struct vars *scan ;
+
+	for ( scan=v_first ; scan ; scan= scan->v_next ) {
+		if ( strcmp(name,scan->v_name)==0 ) {
+			switch ( scan->v_type ) {
+			case string:
+				return scan->v_value.v_string ;
+			case routine:
+				return (*scan->v_value.v_routine)() ;
+			}
+		}
+	}
+	return (char *)0 ;
+}

+ 672 - 0
util/ack/trans.c

@@ -0,0 +1,672 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "list.h"
+#include "trans.h"
+#include "grows.h"
+#include "data.h"
+
+/****************************************************************************/
+/*      Routines for transforming from one file type to another             */
+/****************************************************************************/
+
+static growstring head ;
+static int        touch_head= NO ;
+static growstring tail ;
+static int        touch_tail= NO ;
+
+char *headvar(),*tailvar() ;
+
+int transform(phase) register trf *phase ; {
+	int ok ;
+
+	if ( !setfiles(phase) ) return 0 ;
+	if ( !phase->t_visited ) {
+		/* The flags are set up once.
+		   At the first time the phase is used.
+		   The program name and flags may already be touched
+		   by vieuwargs.
+		*/
+		phase->t_visited=YES ;
+		if ( !rts && phase->t_rts ) rts= phase->t_rts ;
+		if ( phase->t_needed ) {
+			add_head(phase->t_needed) ;
+			add_tail(phase->t_needed) ;
+		}
+	}
+	getcallargs(phase) ;
+	ok= runphase(phase) ;
+	if ( !ok ) rmtemps() ;
+	/* Free the space occupied by the arguments,
+	   except for the combiner, since we are bound to exit soon
+	   and do not foresee further need of memory space */
+	if ( !phase->t_combine ) discardargs(phase) ;
+	disc_files() ;
+	return ok ;
+}
+
+int do_combine() {
+	setsvar(keeps(RTS), keeps(rts? rts : "") ) ;
+	if ( !outfile ) outfile= combiner->t_out ;
+	getmapflags(combiner);
+	return transform(combiner) ;
+}
+
+getmapflags(phase) register trf *phase ; {
+	register list_elem *elem ;
+	int scanned ;
+	register char *ptr ;
+
+	scanlist(l_first(flags),elem) {
+		scanned= *(l_content(*elem))&NO_SCAN ;
+		*(l_content(*elem)) &= ~NO_SCAN ;
+		if ( mapflag(&(phase->t_mapf),l_content(*elem)) ) {
+			scanned=NO_SCAN ;
+#ifdef DEBUG
+			if ( debug >=4 ) {
+				vprint("phase %s, added mapflag for %s\n",
+					phase->t_name,
+					l_content(*elem) ) ;
+			}
+#endif
+		}
+		*(l_content(*elem)) |= scanned ;
+	}
+	if ( phase->t_combine ) {
+		scanlist(l_first(c_arguments),elem) {
+			if ( mapflag(&(phase->t_mapf),l_content(*elem)) ) {
+				throws(l_content(*elem)) ;
+				ptr= keeps(getvar(LIBVAR)) ;
+				clr_noscan(ptr) ;
+				l_content(*elem)= ptr ;
+			}
+		}
+		scanlist(l_first(flags),elem) {
+			/* Get the flags remaining for the loader,
+			   That is: all the flags neither eaten by ack nor
+			   one of the subprograms called so-far.
+			   The last fact is indicated by the NO_SCAN bit
+			   in the first character of the flag.
+			*/
+			if ( !( *(l_content(*elem))&NO_SCAN ) ) {
+				l_add(&(phase->t_flags),l_content(*elem)) ;
+			}
+		}
+	}
+}
+
+
+do_Rflag(argp) char *argp ; {
+	l_add(&R_list,argp) ;
+}
+
+char *needvar() {
+	static growstring needed ;
+	static int been_here = NO ;
+
+	if ( !been_here ) {
+		gr_init(&needed) ;
+		been_here=YES ;
+		gr_cat(&needed,headvar()) ;
+		gr_cat(&needed,tailvar()) ;
+	}
+	return gr_start(needed) ;
+}
+
+char *headvar() {
+	if ( !touch_head) return "" ;
+	return gr_start(head) ;
+}
+
+add_head(str) char *str; {
+	if ( !touch_head) {
+		gr_init(&head) ;
+		touch_head=YES ;
+	}
+	gr_cat(&head,str) ;
+}
+
+char *tailvar() {
+	if ( !touch_tail ) return "" ;
+	return gr_start(tail) ;
+}
+
+add_tail(str) char *str ; {
+	if ( !touch_tail ) {
+		gr_init(&tail) ;
+		touch_tail=YES ;
+	}
+	gr_cat(&tail,str) ;
+}
+
+
+transini() {
+	register list_elem *elem ;
+	register trf *phase ;
+
+	scanlist(l_first(R_list), elem) {
+		set_Rflag(l_content(*elem)) ;
+	}
+	l_clear(&R_list) ;
+	scanlist(l_first(tr_list), elem) {
+		phase = t_cont(*elem) ;
+		if ( !phase->t_combine ) getmapflags(phase);
+	}
+	setpvar(keeps(NEEDS),needvar) ;
+	setpvar(keeps(HEAD),headvar) ;
+	setpvar(keeps(TAIL),tailvar) ;
+}
+
+set_Rflag(argp) register char *argp ; {
+	int     seen ;
+	register char *eos ;
+	register list_elem *prog ;
+	register int length ;
+	char *eq ;
+
+	eos= index(&argp[2],'-');
+	eq= index(&argp[2],EQUAL) ;
+	if ( !eos ) {
+		eos= eq ;
+	} else {
+		if ( eq && eq<eos ) eos= eq ;
+	}
+	if ( !eos ) fuerror("Incorrect use of -R flag") ;
+	length= eos - &argp[2] ;
+	seen=NO ;
+	scanlist(l_first(tr_list), prog) {
+		if ( strncmp(t_cont(*prog)->t_name, &argp[2], length )==0 ) {
+			if ( *eos=='-' ) {
+				l_add(&(t_cont(*prog)->t_flags),eos) ;
+			} else {
+				t_cont(*prog)->t_prog= eos+1 ;
+			}
+			seen=YES ;
+		}
+	}
+	if ( !seen ) error("Cannot find program for %s",argp) ;
+	return ;
+}
+
+/**************************************************************************/
+/*                                                                        */
+/*           The creation of arguments for exec for a transformation      */
+/*                                                                        */
+/**************************************************************************/
+
+growstring scanb(line) char *line ; {
+	/* Scan a line for backslashes, setting the NO_SCAN bit in characters
+	   preceded by a backslash.
+	*/
+	register char *in_c ;
+	register int  token ;
+	growstring result ;
+	enum { TEXT, ESCAPED } state = TEXT ;
+
+	gr_init(&result) ;
+	for ( in_c= line ; *in_c ; in_c++ ) {
+		token= *in_c&0377 ;
+		switch( state ) {
+		case TEXT :
+			if ( token==BSLASH ) {
+				state= ESCAPED ;
+			} else {
+				gr_add(&result,token) ;
+			}
+			break ;
+		case ESCAPED :
+			gr_add(&result,token|NO_SCAN) ;
+			state=TEXT ;
+			break ;
+		}
+	}
+	gr_add(&result,0) ;
+	if ( state!=TEXT ) werror("flag line ends with %c",BSLASH) ;
+	return result ;
+}
+
+growstring scanvars(line) char *line ; {
+	/* Scan a line variable replacements started by S_VAR.
+	   Two sequences exist: S_VAR name E_VAR, S_VAR name A_VAR text E_VAR.
+	   neither name nor text may contain further replacements.
+	   In the first form an error message is issued if the name is not
+	   present in the variables, the second form produces text
+	   in that case.
+	   The sequence S_VAR S_VAR is transformed into S_VAR.
+	   This to allow later recognition in mapflags, where B_SLASH
+	   would be preventing any recognition.
+	*/
+	register char *in_c ;
+	register int  token ;
+	growstring result ;
+	growstring name ;
+	register char *tr ;
+	enum { TEXT, FIRST, NAME, SKIP, COPY } state = TEXT ;
+
+	gr_init(&result) ; gr_init(&name) ;
+	for ( in_c= line ; *in_c ; in_c++ ) {
+		token= *in_c&0377 ;
+		switch( state ) {
+		case TEXT :
+			if ( token==S_VAR ) {
+				state= FIRST ;
+			} else {
+				gr_add(&result,token) ;
+			}
+			break ;
+		case FIRST :
+			switch ( token ) {
+			case S_VAR :
+				state= TEXT ;
+				gr_add(&result,token) ;
+				break ;
+			case A_VAR :
+			case C_VAR :
+				fatal("empty string variable name") ;
+			default :
+				state=NAME ;
+				gr_add(&name,token) ;
+				break ;
+			}
+			break ;
+		case NAME:
+			switch ( token ) {
+			case A_VAR :
+				gr_add(&name,0) ;
+				if ( tr=getvar(gr_start(name)) ) {
+					while ( *tr ) {
+						gr_add(&result,*tr++) ;
+					}
+					state=SKIP ;
+				} else {
+					state=COPY ;
+				}
+				gr_throw(&name) ;
+				break ;
+			case C_VAR :
+				gr_add(&name,0) ;
+				if ( tr=getvar(gr_start(name)) ) {
+					while ( *tr ) {
+					   gr_add(&result,*tr++);
+					}
+				} else {
+					werror("No definition for %s",
+						gr_start(name)) ;
+				}
+				state=TEXT ;
+				gr_throw(&name) ;
+				break ;
+			default:
+				gr_add(&name,token) ;
+				break ;
+			}
+			break ;
+		case SKIP :
+			if ( token==C_VAR ) state= TEXT ;
+			break ;
+		case COPY :
+			if ( token==C_VAR ) state= TEXT ; else {
+				gr_add(&result,token) ;
+			}
+			break ;
+		}
+	}
+	gr_add(&result,0) ;
+	if ( state!=TEXT ) {
+		werror("flag line misses %c",C_VAR) ;
+		gr_throw(&name) ;
+	}
+	return result ;
+}
+
+growstring scanexpr(line) char *line ; {
+	/* Scan a line for conditional or flag expressions,
+	   dependent on the type. The format is
+	   S_EXPR suflist M_EXPR suflist T_EXPR tail C_EXPR
+	   the head and tail are passed to treat, together with the
+	   growstring for futher treatment.
+	   Nesting is not allowed.
+	*/
+	register char *in_c ;
+	char *heads ;
+	register int  token ;
+	growstring sufs, tailval ;
+	growstring result ;
+	static list_head fsuff, lsuff ;
+	enum { TEXT, FDOT, FSUF, LDOT, LSUF, FTAIL } state = TEXT ;
+
+	gr_init(&result) ; gr_init(&sufs) ; gr_init(&tailval) ;
+	for ( in_c= line ; *in_c ; in_c++ ) {
+		token= *in_c&0377 ;
+		switch( state ) {
+		case TEXT :
+			if ( token==S_EXPR ) {
+				state= FDOT ;
+				heads=in_c ;
+			} else gr_add(&result,token) ;
+			break ;
+		case FDOT :
+			if ( token==M_EXPR ) {
+				state=LDOT ;
+				break ;
+			}
+			token &= ~NO_SCAN ;
+			if ( token!=SUFCHAR ) {
+				error("Missing %c in expression",SUFCHAR) ;
+			}
+			gr_add(&sufs,token) ; state=FSUF ;
+			break ;
+		case FSUF :
+			if ( token==M_EXPR || (token&~NO_SCAN)==SUFCHAR) {
+				gr_add(&sufs,0) ;
+				l_add(&fsuff,gr_final(&sufs)) ;
+			}
+			if ( token==M_EXPR ) {
+				state=LDOT ;
+			} else gr_add(&sufs,token&~NO_SCAN) ;
+			break ;
+		case LDOT :
+			if ( token==T_EXPR ) {
+				state=FTAIL ;
+				break ;
+			}
+			token &= ~NO_SCAN ;
+			if ( token!=SUFCHAR ) {
+				error("Missing %c in expression",SUFCHAR) ;
+			}
+			gr_add(&sufs,token) ; state=LSUF ;
+			break ;
+		case LSUF :
+			if ( token==T_EXPR || (token&~NO_SCAN)==SUFCHAR) {
+				gr_add(&sufs,0) ;
+				l_add(&lsuff,gr_final(&sufs)) ;
+			}
+			if ( token==T_EXPR ) {
+				state=FTAIL ;
+			} else gr_add(&sufs,token&~NO_SCAN) ;
+			break ;
+		case FTAIL :
+			if ( token==C_EXPR ) {
+				/* Found one !! */
+				gr_add(&tailval,0) ;
+				condit(&result,&fsuff,&lsuff,gr_start(tailval)) ;
+				l_throw(&fsuff) ; l_throw(&lsuff) ;
+				gr_throw(&tailval) ;
+				state=TEXT ;
+			} else gr_add(&tailval,token) ;
+			break ;
+		}
+	}
+	gr_add(&result,0) ;
+	if ( state!=TEXT ) {
+		l_throw(&fsuff) ; l_throw(&lsuff) ; gr_throw(&tailval) ;
+		werror("flag line has unclosed expression starting with %6s",
+			heads) ;
+	}
+	return result ;
+}
+
+condit(line,fsuff,lsuff,tailval) growstring *line ;
+	list_head *fsuff, *lsuff;
+	char *tailval ;
+{
+	register list_elem *first ;
+	register list_elem *last ;
+
+#ifdef DEBUG
+	if ( debug>=4 ) vprint("Conditional for %s, ",tailval) ;
+#endif
+	scanlist( l_first(*fsuff), first ) {
+		scanlist( l_first(*lsuff), last ) {
+			if ( strcmp(l_content(*first),l_content(*last))==0 ) {
+				/* Found */
+#ifdef DEBUG
+				if ( debug>=4 ) vprint(" matched\n") ;
+#endif
+				while ( *tailval) gr_add(line,*tailval++ ) ;
+				return ;
+			}
+		}
+	}
+#ifdef DEBUG
+	if ( debug>=4) vprint(" non-matched\n") ;
+#endif
+}
+
+int mapflag(maplist,cflag) list_head *maplist ; char *cflag ; {
+	/* Expand a flag expression */
+	/* The flag "cflag" is checked for each of the mapflags.
+	   A mapflag entry has the form
+		-text NAME=replacement or -text*text NAME=replacement
+	   The star matches anything as in the shell.
+	   If the entry matches the assignment will take place
+	   This replacement is subjected to argument matching only.
+	   When a match took place the replacement is returned
+	   when not, (char *)0.
+	   The replacement sits in stable storage.
+	*/
+	register list_elem *elem ;
+
+	scanlist(l_first(*maplist),elem) {
+		if ( mapexpand(l_content(*elem),cflag) ) {
+			return 1 ;
+		}
+	}
+	return 0 ;
+}
+
+int mapexpand(mapentry,cflag)
+	char *mapentry, *cflag ;
+{
+	register char *star ;
+	register char *ptr ;
+	register char *space ;
+	int length ;
+
+	star=index(mapentry,STAR) ;
+	space=firstblank(mapentry) ;
+	if ( star >space ) star= (char *)0 ;
+	if ( star ) {
+		length= space-star-1 ;
+		if ( strncmp(mapentry,cflag,star-mapentry) ||
+		     strncmp(star+1,cflag+strlen(cflag)-length,length) ) {
+			return 0 ;
+		}
+		/* Match */
+		/* Now set star to the first char of the star
+		   replacement and length to its length
+		*/
+		length=strlen(cflag)-(star-mapentry)-length ;
+		if ( length<0 ) return 0 ;
+		star=cflag+(star-mapentry) ;
+#ifdef DEBUG
+		if ( debug>=6 ) {
+			vprint("Starmatch (%s,%s) %.*s\n",
+				mapentry,cflag,length,star) ;
+		}
+#endif
+	} else {
+		if ( strncmp(mapentry,cflag,space-mapentry)!=0 ||
+		     cflag[space-mapentry] ) {
+			return 0 ;
+		}
+	}
+	ptr= skipblank(space) ;
+	if ( *ptr==0 ) return 1 ;
+	doassign(ptr,star,length) ;
+	return 1 ;
+}
+
+doassign(line,star,length) char *line, *star ; {
+	growstring varval, name, temp ;
+	register char *ptr ;
+
+	gr_init(&varval) ;
+	gr_init(&name) ;
+	ptr= line ;
+	for ( ; *ptr && *ptr!=SPACE && *ptr!=TAB && *ptr!=EQUAL ; ptr++ ) {
+		gr_add(&name,*ptr) ;
+	}
+	ptr= index(ptr,EQUAL) ;
+	if ( !ptr ) {
+		error("Missing %c in assignment %s",EQUAL,line);
+		return ;
+	}
+	temp= scanvars(ptr+1) ;
+	for ( ptr=gr_start(temp); *ptr; ptr++ ) switch ( *ptr ) {
+	case STAR :
+		if ( star ) {
+			while ( length-- ) gr_add(&varval,*star++|NO_SCAN) ;
+			break ;
+		}
+	default :
+		gr_add(&varval,*ptr) ;
+		break ;
+	}
+	gr_throw(&temp) ;
+	setsvar(gr_final(&name),gr_final(&varval)) ;
+}
+
+#define ISBLANK(c) ( (c)==SPACE || (c)==TAB )
+
+unravel(line,action) char *line ; int (*action)() ; {
+	/* Unravel the line, get arguments a la shell */
+	/* each argument is handled to action */
+	/* The input string is left intact */
+	register char *in_c ;
+	register int  token ;
+	enum { BLANK, ARG } state = BLANK ;
+	growstring argum ;
+
+	in_c=line ;
+	for (;;) {
+		token= *in_c&0377 ;
+		switch ( state ) {
+		case BLANK :
+			if ( token==0 ) break ;
+			if ( !ISBLANK(token) ) {
+				state= ARG ;
+				gr_init(&argum) ;
+				gr_add(&argum,token&~NO_SCAN) ;
+			}
+			break ;
+		case ARG :
+			if ( ISBLANK(token) || token==0 ) {
+				gr_add(&argum,0) ;
+				(*action)(gr_start(argum)) ;
+				gr_throw(&argum) ;
+				state=BLANK ;
+			} else {
+				gr_add(&argum,token&~NO_SCAN) ;
+			}
+			break ;
+		}
+		if ( token == 0 ) break ;
+		in_c++ ;
+	}
+}
+
+char *c_rep(string,place,rep) char *string, *place, *rep ; {
+	/* Produce a string in stable storage produced from 'string'
+	   with the character at place replaced by rep
+	*/
+	growstring name ;
+	register char *nc ;
+	register char *xc ;
+
+	gr_init(&name) ;
+	for ( nc=string ; *nc && nc<place ; nc++ ) {
+		gr_add(&name,*nc) ;
+	}
+#ifdef DEBUG
+	if ( *nc==0 ) fatal("Place is not in string") ;
+#endif
+	for ( xc=rep ; *xc ; xc++ ) gr_add(&name,*xc|NO_SCAN) ;
+	gr_add(&name,0) ;
+	gr_cat(&name,nc+1) ;
+	return gr_final(&name) ;
+}
+
+static list_head *curargs ;
+
+addargs(string) char *string ; {
+	register char *temp, *repc ;
+	register list_elem *elem ;
+
+	repc=index(string,C_IN) ;
+	if ( repc ) {
+		/* INPUT FILE TOKEN seen, replace it and scan further */
+		if ( repc==string && string[1]==0 ) {
+			if ( in.p_path ) { /* All but combiner */
+				l_add(curargs,keeps(in.p_path)) ;
+			} else {
+				scanlist( l_first(c_arguments), elem ) {
+					l_add(curargs,l_content(*elem)) ;
+				}
+			}
+			return ;
+		}
+		if ( in.p_path ) { /* Not for the combiner */
+			temp=c_rep(string,repc,in.p_path) ;
+			addargs(temp) ;
+			throws(temp) ;
+		} else {           /* For the combiner */
+			scanlist( l_first(c_arguments), elem ) {
+				temp=c_rep(string,repc,l_content(*elem)) ;
+				addargs(temp) ;
+				throws(temp) ;
+			}
+		}
+		return ;
+	}
+	repc=index(string,C_OUT) ;
+	if ( repc ) {
+		/* replace the outfile token as with the infile token */
+#ifdef DEBUG
+		if ( !out.p_path ) fatal("missing output filename") ;
+#endif
+		temp=c_rep(string,repc,out.p_path) ;
+		addargs(temp) ;
+		throws(temp) ;
+		return ;
+	}
+	temp= keeps(string) ;
+	clr_noscan(temp) ;
+	l_add(curargs,temp) ;
+}
+
+getcallargs(phase) register trf *phase ; {
+	growstring arg1, arg2 ;
+
+	arg1= scanvars(phase->t_argd) ;
+#ifdef DEBUG
+	if ( debug>=3 ) { vprint("\tvars: ") ; prns(gr_start(arg1)) ; }
+#endif
+	arg2= scanexpr(gr_start(arg1)) ;
+#ifdef DEBUG
+	if ( debug>=3 ) { vprint("\texpr: ") ; prns(gr_start(arg2)) ; }
+#endif
+	gr_throw(&arg1) ;
+	curargs= &phase->t_args ;
+	unravel( gr_start(arg2), addargs ) ;
+	gr_throw(&arg2) ;
+}
+
+discardargs(phase) register trf *phase ; {
+	l_throw(&phase->t_args) ;
+}

+ 30 - 0
util/ack/trans.h

@@ -0,0 +1,30 @@
+/* This structure is the center of all actions */
+/* It contains the description of all phases,
+   the suffices they consume and produce and various properties */
+
+typedef struct transform trf;
+
+struct transform {
+	char    *t_in ;         /* Suffices in '.o.k' */
+	char    *t_out ;        /* Result '.suffix' or 'name' */
+	char    *t_name ;       /* The name of this transformation */
+	list_head t_mapf ;      /* Mapflags argument, uses varrep */
+	char    *t_argd ;       /* Argument descriptor, uses varrep */
+	char    *t_needed ;     /* Suffix indicating the libraries needed */
+	char    *t_rts ;        /* Suffix indicating the major language used*/
+	int     t_stdin:1 ;     /* The input is taken on stdin */
+	int     t_stdout:1 ;    /* The output comes on stdout */
+	int     t_combine:1 ;   /* Transform several files to one result */
+	int     t_visited:1 ;   /* NO before setup, YES after */
+	int     t_prep:2 ;      /* Needs preprocessor YES/NO/MAYBE */
+	int     t_optim:1 ;     /* Is optimizer */
+	int     t_isprep:1 ;    /* Is preprocessor */
+	int     t_keep:1 ;      /* Keep the output file */
+	char    *t_prog ;       /* Pathname for load file */
+	list_head t_flags ;     /* List of flags */
+	list_head t_args ;      /* List of arguments */
+	int     t_scan:1 ;      /* Used while finding path's */
+	int     t_do:1 ;        /* Is in path to execute */
+} ;
+
+#define t_cont(elem) ((trf *)l_content(elem))

+ 190 - 0
util/ack/util.c

@@ -0,0 +1,190 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/**********************************************************************/
+/*                                                                    */
+/*               Several utility routines used throughout ack         */
+/*               error handling, string handling and such.            */
+/*                                                                    */
+/**********************************************************************/
+
+#include "ack.h"
+#include <ctype.h>
+#include <stdio.h>
+
+extern  char    *progname ;
+extern  int     w_flag ;
+extern  int     n_error;
+
+extern  char    *calloc();
+extern  char    *realloc();
+
+#ifdef DEBUG
+# define STDOUT stdout
+#else
+# define STDOUT stderr
+#endif
+
+char *basename(string) char *string ; {
+	static char retval[20] ;
+	char *last_dot, *last_start ;
+	register char *store;
+	register char *fetch ;
+	register int ctoken ;
+
+	last_dot= (char *)0 ;
+	last_start= string ;
+	for ( fetch=string ; ; fetch++ ) {
+		switch ( ctoken= *fetch&0377 ) {
+		case SUFCHAR : last_dot=fetch ; break ;
+		case '/'     : last_start=fetch+1 ; break ;
+		case  0      : goto out ;
+		}
+		if ( !isascii(ctoken) || !isprint(ctoken) ) {
+			werror("non-ascii characters in argument %s",string) ;
+		}
+	}
+out:
+	if ( ! *last_start ) fuerror("empty filename \"%s\"",string) ;
+	for ( fetch= last_start, store=retval ;
+		*fetch && fetch!=last_dot && store< &retval[sizeof retval-1] ;
+		      fetch++, store++ ) {
+				*store= *fetch ;
+	}
+	*store= 0 ;
+	return retval ;
+}
+
+clr_noscan(str) char *str ; {
+	register char *ptr ;
+	for ( ptr=str ; *ptr ; ptr++ ) {
+		*ptr&= ~NO_SCAN ;
+	}
+}
+
+char *skipblank(str) char *str ; {
+	register char *ptr ;
+
+	for ( ptr=str ; *ptr==SPACE || *ptr==TAB ; ptr++ ) ;
+	return ptr ;
+}
+
+char *firstblank(str) char *str ; {
+	register char *ptr ;
+
+	for ( ptr=str ; *ptr && *ptr!=SPACE && *ptr!=TAB ; ptr++ ) ;
+	return ptr ;
+}
+
+/* VARARGS1 */
+fatal(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
+	/* Fatal internal error */
+	fprintf(STDOUT,"%s: fatal internal error, ",progname) ;
+	fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
+	fprintf(STDOUT,"\n") ;
+	quit(-2) ;
+}
+
+
+/* VARARGS1 */
+vprint(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
+	/* Diagnostic print, no auto NL */
+	fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
+}
+
+#ifdef DEBUG
+prns(s) register char *s ; {
+	for ( ; *s ; s++ ) {
+		putc((*s&0377)&~NO_SCAN,STDOUT) ;
+	}
+	putc('\n',STDOUT) ;
+}
+#endif
+
+/* VARARGS1 */
+fuerror(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
+	/* Fatal user error */
+	fprintf(STDOUT,"%s: ",progname) ;
+	fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
+	fprintf(STDOUT,"\n") ;
+	quit(-1) ;
+}
+
+/* VARARGS1 */
+werror(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
+	/* Warning user error, w_flag */
+	if ( w_flag ) return ;
+	fprintf(STDOUT,"%s: warning, ",progname) ;
+	fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
+	fprintf(STDOUT,"\n") ;
+}
+
+/* VARARGS1 */
+error(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
+	/* User error, it is the callers responsibility to quit */
+	fprintf(STDOUT,"%s: ",progname) ;
+	fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
+	fprintf(STDOUT,"\n") ;
+	n_error++ ;
+}
+
+do_flush() {
+	fflush(stdout) ;
+	fflush(stderr) ;
+}
+
+noodstop() {
+	quit(-3) ;
+}
+
+quit(code) {
+	rmtemps();
+	exit(code);
+}
+/******
+	char *keeps(string)
+		Keep the string in stable storage.
+	throws(string)
+		Remove the string stored by keep from stable storage.
+***********/
+
+char *keeps(str) char *str ; {
+	register char *result ;
+	result= getcore( (unsigned)(strlen(str)+1) ) ;
+	if ( !result ) fatal("Out of core") ;
+	return strcpy(result,str) ;
+}
+
+throws(str) char *str ; {
+	freecore(str) ;
+}
+
+char *getcore(size) unsigned size ; {
+	register char *retptr ;
+
+	retptr= calloc(1,size) ;
+	if ( !retptr ) fatal("Out of memory") ;
+	return retptr ;
+}
+
+char *changecore(ptr,size) char *ptr ; unsigned size ; {
+	register char *retptr ;
+
+	retptr= realloc(ptr,size) ;
+	if ( !retptr ) fatal("Out of memory") ;
+	return retptr ;
+}

+ 30 - 0
util/cgg/Makefile

@@ -0,0 +1,30 @@
+# $Header$
+
+PREFLAGS=-I../../h
+CFLAGS=$(PREFLAGS)
+LDFLAGS=-i
+LINTOPTS=-hbxac $(PREFLAGS)
+LIBS=../../lib/em_data.a
+# LEXLIB is system dependent, try -ll or -lln first
+LEXLIB=-lln
+
+cgg:	bootgram.o
+	cc $(LDFLAGS) bootgram.o $(LIBS) $(LEXLIB) -o cgg
+
+bootgram.c:	bootgram.y
+	@echo expect 1 shift/reduce conflict
+	yacc bootgram.y
+	mv y.tab.c bootgram.c
+
+install:	cgg
+	cp cgg ../../lib/cgg
+
+cmp:		cgg
+	cmp cgg ../../lib/cgg
+
+lint:	bootgram.c
+	lint $(LINTOPTS) bootgram.c
+clean:
+	rm -f bootgram.o bootgram.c bootlex.c cgg
+bootgram.o:	bootlex.c
+bootgram.o:	../../h/cg_pattern.h

+ 2317 - 0
util/cgg/bootgram.y

@@ -0,0 +1,2317 @@
+%{
+
+#ifndef NORCSID
+static char rcsid[]="$Header$";
+#endif
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#ifdef vax | vax2 | vax4
+#define BIG
+#endif
+
+#ifdef BIG
+#define BORS(x,y) x
+#else
+#define BORS(x,y) y
+#endif
+/* Tunable constants */
+
+#define MAXALLREG 5             /* Maximum number of allocates per rule */
+#define MAXREGS BORS(36,32)     /* Total number of registers */
+#define MAXREGVARS 8		/* Maximum regvars per type */
+#define MAXPROPS 16             /* Total number of register properties */
+#define MAXTOKENS BORS(75,32)   /* Different kind of tokens */
+#define MAXSETS BORS(100,80)    /* Number of tokenexpressions definable */
+#define MAXEMPATLEN 25		/* Maximum length of EM-pattern/replacement */
+#define TOKENSIZE 5             /* Maximum number of fields in token struct */
+#define MAXINSTANCE BORS(175,120) /* Maximum number of different tokeninstances */
+#define MAXSTRINGS BORS(600,400)/* Maximum number of different codestrings */
+#define MAXPATTERN BORS(7000,6000) /* Maximum number of bytes in pattern[] */
+#define MAXNODES BORS(450,350)  /* Maximum number of expression nodes */
+#define MAXMEMBERS 2            /* Maximum number of subregisters per reg */
+#define NMOVES BORS(50,30)      /* Maximum number of move definitions */
+#define MAXC1   20              /* Maximum of coercions type 1 */
+#define MAXC2   20              /* Maximum of coercions type 2 */
+#define MAXC3   20              /* Maximum of coercions type 3 */
+#define MAXSPLIT 4              /* Maximum degree of split */
+#define MAXNSTR 40		/* Maximum consecutive strings in coderule */
+
+/* Derived constants */
+
+#define SETSIZE ((MAXREGS+1+MAXTOKENS+15)>>4)
+#define PROPSETSIZE ((MAXPROPS+15)>>4)
+
+#define BMASK 0377
+#define BSHIFT 8
+
+#define TRUE    1
+#define FALSE   0
+
+#define MAXPATLEN 7             /* Maximum length of tokenpatterns */
+
+typedef char byte;
+typedef char * string;
+
+#include <stdio.h>
+#include <assert.h>
+#include <ctype.h>
+#include <em_spec.h>
+#include <em_flag.h>
+#include <em_reg.h>
+#include <cg_pattern.h>
+
+typedef struct list1str {
+	struct list1str *l1next;
+	string l1name;
+} *list1;
+typedef struct list2str {
+	struct list2str *l2next;
+	list1 l2list;
+} *list2;
+typedef struct list3str {
+	struct list3str *l3next;
+	list2 l3list;
+} *list3;
+
+typedef struct reginfo {
+	string rname;
+	string rrepr;
+	int rsize;
+	int rmembers[MAXMEMBERS];
+	int rregvar;
+	short rprop[PROPSETSIZE];
+} *reginfo;
+
+typedef struct tokeninfo {
+	string t_name;
+	list2 t_struct;
+	struct {
+		int t_type;
+		string t_sname;
+	} t_fields[TOKENSIZE-1];
+	int t_size;
+	cost_t t_cost;
+	int t_format;
+} token_t,*token_p;
+
+typedef struct ident {
+	struct ident *i_next;
+	string i_name;
+	int i_type;
+#               define IREG 1
+#               define IPRP 2
+#               define ITOK 3
+#               define IEXP 4
+	union {
+		int i_regno;
+		int i_prpno;
+		int i_tokno;
+		int i_expno;
+	} i_i;
+} ident_t,*ident_p;
+
+#define ITABSIZE 32
+ident_p identtab[ITABSIZE];
+
+#define LOOKUP          0
+#define HALFWAY         1
+#define ENTER           2
+#define JUSTLOOKING     3
+
+
+typedef struct expr {
+	int expr_typ;
+#               define TYPINT  1
+#               define TYPREG  2
+#               define TYPSTR  3
+#               define TYPBOOL 4
+	int expr_index;
+} expr_t,*expr_p;
+
+unsigned cc1=1,cc2=1,cc3=1,cc4=1;
+
+node_t  nodes[MAXNODES];
+node_p  lastnode=nodes+1;
+
+string codestrings[MAXSTRINGS];
+int ncodestrings;
+
+int strar[MAXNSTR];
+int nstr;
+
+int pathash[256];
+
+reginfo machregs[MAXREGS];
+char stregclass[MAXREGS];
+int nmachregs=1;
+int nregclasses=1;
+int maxmembers;
+struct {
+	ident_p propname;
+	set_t	propset;
+} machprops[MAXPROPS];
+int nprops=0;
+token_t machtokens[MAXTOKENS];
+int nmachtokens=1;
+set_t machsets[MAXSETS];
+int nmachsets=0;
+int patmnem[MAXEMPATLEN];
+int empatlen;
+int maxempatlen;
+int empatexpr;
+int maxrule=1;
+int pattokexp[MAXPATLEN];
+int tokpatlen;
+int lookident=0;        /* lexical analyzer flag */
+list3 structpool=0;
+int nallreg;
+int allreg[MAXALLREG];
+int maxallreg;
+int lino=0;
+int nerrors=0;
+int curtokexp;
+expr_t arexp[TOKENSIZE];
+int narexp;
+inst_t arinstance[MAXINSTANCE];
+int narinstance=1;
+move_t machmoves[NMOVES];
+int nmoves=0;
+byte pattern[MAXPATTERN];
+int npatbytes=0;
+int prevind;
+int rulecount;                  /* Temporary index for ... construct */
+int ncoderules=0;
+int codebytes=0;
+FILE *cfile;
+FILE *hfile;
+int maxtokensize=0;
+int dealflag;
+int emrepllen;
+int replmnem[MAXEMPATLEN];
+int tokrepllen;
+int replinst[MAXPATLEN];
+int replexpr[MAXPATLEN];
+c1_t c1coercs[MAXC1];
+c2_t c2coercs[MAXC2];
+c3_t c3coercs[MAXC3];
+int nc1=0,nc2=0,nc3=0;
+int maxsplit=0;
+int wsize= -1;
+int psize= -1;
+int bsize= -1;
+char *fmt=0;
+
+int cchandled;
+int ccspoiled;
+int ccregexpr;
+int ccinstanceno;
+int cocopropno;
+int cocosetno;
+int allexpno;
+
+int rvused;	/* regvars used */
+int nregvar[4];	/* # of register variables of all kinds */
+int rvnumbers[4][MAXREGVARS];	/* The register numbers */
+
+#define chktabsiz(size,maxsize,which) if(size>=maxsize) tabovf(which)
+
+#define MUST1BEINT(e) int exp1=e.expr_index;tstint(e)
+#define MUST2BEINT(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstint(e1);tstint(e2)
+#define MUST1BEBOOL(e) int exp1=e.expr_index;tstbool(e)
+#define MUST2BEBOOL(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstbool(e1);tstbool(e2)
+
+%}
+
+%union {
+	int yy_int;
+	int *yy_intp;
+	string yy_string;
+	list1 yy_list1;
+	list2 yy_list2;
+	expr_t yy_expr;
+	cost_t yy_cost;
+	set_t yy_set;
+	ident_p yy_ident;
+	char yy_char;
+	inst_t yy_instance;
+}
+
+%type <yy_list1> list1,structlistel
+%type <yy_list2> structlist,structdecl
+%type <yy_expr> expr optexpr
+%type <yy_cost> optcost cost optcommacost
+%type <yy_int> optboolexpr optnocoerc mnem emargno tokargno optprop
+%type <yy_int> optcommabool optstack subreg tokenexpressionno optregvar
+%type <yy_int> tokeninstanceno code stackreplacement optslashnumber
+%type <yy_set> tokenexpression
+%type <yy_instance> tokeninstance
+%type <yy_string> optformat
+%token <yy_string> IDENT TYPENAME
+%token <yy_ident> RIDENT,PIDENT,TIDENT,EIDENT
+%token <yy_string> LSTRING,STRING
+%token <yy_int> NUMBER
+%token <yy_intp> CIDENT
+%token REGISTERHEAD TOKENHEAD EXPRESSIONHEAD CODEHEAD MOVEHEAD TESTHEAD STACKHEAD
+%token REGVAR INREG LOOP POINTER FLOAT
+%token TIMEFAC SIZEFAC FORMAT RETURN
+%token MOVE ERASE ALLOCATE ELLIPS COST REMOVE STACK
+%token SEP SAMESIGN SFIT UFIT ROM DEFINED TOSTRING LOWW HIGHW
+%token NOCC SETCC SAMECC TEST NOCOERC
+%token <yy_char> LCASELETTER
+%start machinespec
+
+%left OR2
+%left AND2
+%left CMPEQ,CMPNE
+%left CMPLT,CMPLE,CMPGT,CMPGE
+%left RSHIFT,LSHIFT
+%left '+','-'
+%left '*','/','%'
+%nonassoc NOT,COMP,UMINUS
+%nonassoc '$'
+%%
+machinespec
+	: rcsid constants registersection tokensection
+		{ inbetween(); }
+	  expressionsection codesection movesection testsection stacksection
+	;
+
+rcsid
+	: /* empty */
+	| STRING
+		{ strlookup($1); }
+	;
+
+constants
+	: /* empty */
+	| constants CIDENT '=' NUMBER
+		{ *$2 = $4; }
+	| constants SIZEFAC '=' NUMBER optslashnumber
+		{ cc1 = $4; cc2 = $5; }
+	| constants TIMEFAC '=' NUMBER optslashnumber
+		{ cc3 = $4; cc4 = $5; }
+	| constants FORMAT '=' STRING
+		{ fmt = $4; }
+	;
+optslashnumber
+	: /* empty */
+		{ $$ = 1; }
+	| '/' NUMBER
+		{ $$ = $2; }
+	;
+
+registersection
+	: REGISTERHEAD registerdefs
+	;
+registerdefs
+	: /* empty */
+	| registerdefs registerdef
+	;
+
+registerdef
+	: IDENT '=' '(' STRING ',' NUMBER list1 ')' optregvar list1 '.'
+		{       register ident_p ip;
+			register list1 l;
+			register reginfo r;
+			int i;
+
+			r=(reginfo) myalloc(sizeof(struct reginfo));
+			r->rname = $1;
+			r->rrepr = $4;
+			r->rsize = $6;
+			if($9>=0 && $7!=0)
+				yyerror("No subregisters allowed in regvar");
+			for (i=0;i<MAXMEMBERS;i++)
+				r->rmembers[i] = 0;
+			i=0;
+			for (l=$7;l!=0;l=l->l1next) {
+				ip=ilookup(l->l1name,LOOKUP);
+				if (ip->i_type != IREG)
+					yyerror("Bad member of set");
+				chktabsiz(i,MAXMEMBERS,"Member of register");
+				r->rmembers[i++] = ip->i_i.i_regno;
+			}
+			maxmembers=max(maxmembers,i);
+			r->rregvar=$9;
+			if ($9>=0) {
+				rvused=1;
+				chktabsiz(nregvar[$9],MAXREGVARS,"Regvar");
+				rvnumbers[$9][nregvar[$9]++] = nmachregs;
+			}
+			for(i=0;i<PROPSETSIZE;i++)
+				r->rprop[i] = 0;
+			ip=ilookup($1,ENTER);
+			ip->i_type=IREG;
+			ip->i_i.i_regno=nmachregs;
+			for (l = $10; l!= 0; l=l->l1next) {
+				ip = ilookup(l->l1name,HALFWAY);
+				if (ip->i_type) {
+					if (ip->i_type != IPRP)
+						yyerror("Multiple defined symbol");
+					else if(machprops[ip->i_i.i_prpno].propset.set_size != r->rsize)
+						yyerror("property has more than 1 size");
+				} else {
+					chktabsiz(nprops,MAXPROPS,"Property");
+					ip->i_type = IPRP;
+					ip->i_i.i_prpno = nprops;
+					machprops[nprops].propname = ip;
+					machprops[nprops++].propset.set_size = r->rsize;
+				}
+				r->rprop[ip->i_i.i_prpno>>4] |= (1<<(ip->i_i.i_prpno&017));
+			}
+			chktabsiz(nmachregs,MAXREGS,"Register table");
+			machregs[nmachregs++] = r;
+		}
+	| error '.'
+	;
+
+optregvar
+	: /* nothing */
+		{ $$ = -1; }
+	| REGVAR
+		{ $$ = reg_any; }
+	| REGVAR '(' LOOP ')'
+		{ $$ = reg_loop; }
+	| REGVAR '(' POINTER ')'
+		{ $$ = reg_pointer; }
+	| REGVAR '(' FLOAT ')'
+		{ $$ = reg_float; }
+	;
+
+tokensection
+	: TOKENHEAD tkdefs
+	;
+tkdefs
+	: /* empty */
+	| tkdefs tkdef
+	;
+tkdef
+	: IDENT '=' structdecl NUMBER optcost optformat
+		{ register token_p tp;
+		  register ident_p ip;
+
+		  chktabsiz(nmachtokens,MAXTOKENS,"Token table");
+		  tp = &machtokens[nmachtokens];
+		  tp->t_name = $1;
+		  tp->t_struct = $3;
+		  tp->t_size = $4;
+		  tp->t_cost = $5;
+		  ip = ilookup($1,ENTER);
+		  ip->i_type = ITOK;
+		  ip->i_i.i_tokno = nmachtokens++;
+		  maxtokensize=max(maxtokensize,structsize($3));
+		  setfields(tp,$6);
+		}
+	| error
+	;
+structdecl
+	: '{' structlist '}'
+		{ $$ = lookstruct($2); }
+	;
+structlist
+	: /* empty */
+		{ $$=0; }
+	| structlistel structlist
+		{ $$=(list2) myalloc(sizeof(struct list2str));
+		  $$->l2next = $2;
+		  $$->l2list = $1;
+		}
+	;
+structlistel
+	: TYPENAME list1 ';'
+		{ $$=(list1) myalloc(sizeof(struct list1str));
+		  $$->l1next = $2;
+		  $$->l1name = $1;
+		}
+	;
+
+optcost : /* empty */
+		{ $$.c_size = $$.c_time = 0; }
+	| COST '=' '(' expr ',' expr ')'
+		{ MUST2BEINT($4,$6);
+		  $$.c_size = exp1;
+		  $$.c_time = exp2;
+		}
+	;
+optformat
+	: /* empty */
+		{ $$ = 0; }
+	| STRING
+	;
+
+expressionsection
+	: /* empty */
+	| EXPRESSIONHEAD tokenexpressions
+	;
+tokenexpressions
+	: tokenexpressionline
+	| tokenexpressionline tokenexpressions
+	;
+tokenexpressionline
+	: IDENT '=' tokenexpression
+		{
+		  {     register ident_p ip;
+
+			chktabsiz(nmachsets,MAXSETS,"Expression table");
+			machsets[nmachsets] = $3;
+			ip=ilookup($1,ENTER);
+			ip->i_type = IEXP;
+			ip->i_i.i_expno = nmachsets++;
+		  }
+		}
+	| error
+	;
+tokenexpression
+	: PIDENT
+		{ $$ = machprops[$1->i_i.i_prpno].propset; }
+	| TIDENT
+		{ register i;
+
+		  for(i=0;i<SETSIZE;i++) $$.set_val[i]=0;
+		  $$.set_val[($1->i_i.i_tokno+nmachregs+1)>>4] |=
+			01<<(($1->i_i.i_tokno+nmachregs+1)&017);
+		  $$.set_size = machtokens[$1->i_i.i_tokno].t_size;
+		}
+	| EIDENT
+		{ $$=machsets[$1->i_i.i_expno]; }
+	| tokenexpression '*' tokenexpression
+		{ register i;
+
+		  if (($$.set_size=$1.set_size)==0)
+			$$.set_size = $3.set_size;
+		  for (i=0;i<SETSIZE;i++)
+			$$.set_val[i] = $1.set_val[i] & $3.set_val[i];
+		}
+	| tokenexpression '+' tokenexpression
+		{ register i;
+
+		  if ($1.set_size == -1)
+			$$.set_size = $3.set_size;
+		  else if ($3.set_size == -1)
+			$$.set_size = $1.set_size;
+		  else if ($1.set_size == $3.set_size)
+			$$.set_size = $1.set_size;
+		  else
+			$$.set_size = 0;
+		  for (i=0;i<SETSIZE;i++)
+			$$.set_val[i] = $1.set_val[i] | $3.set_val[i];
+		}
+	| tokenexpression '-' tokenexpression
+		{ register i;
+
+		  if ($1.set_size == -1)
+			$$.set_size = $3.set_size;
+		  else if ($3.set_size == -1)
+			$$.set_size = $1.set_size;
+		  else if ($1.set_size == $3.set_size)
+			$$.set_size = $1.set_size;
+		  else
+			$$.set_size = 0;
+		  for (i=0;i<SETSIZE;i++)
+			$$.set_val[i] = $1.set_val[i] & ~ $3.set_val[i];
+		}
+	| '(' tokenexpression ')'
+		{ $$ = $2; }
+	;
+
+codesection
+	: CODEHEAD coderules
+	;
+coderules
+	: coderule
+	| coderules coderule
+	;
+coderule
+	: { nallreg=emrepllen=tokrepllen=0; }
+		empattern SEP stackpattern SEP code SEP stackreplacement SEP
+		emreplacement SEP cost
+			{ int i;
+
+			  if (emrepllen) {
+				outbyte(DO_EMREPLACE+(emrepllen<<5));
+				for (i=0;i<emrepllen;i++) {
+					out(replmnem[i]);
+					out(replexpr[i]);
+				}
+			  }
+			  if ($8==0) {
+				  outbyte(DO_TOKREPLACE+(tokrepllen<<5));
+				  for(i=0;i<tokrepllen;i++)
+					out(replinst[i]);
+			  } else {
+				static int warncount=0;
+				if (!warncount++)
+					fprintf(stderr,
+		"WARNING: convert to stacksection, will disappear soon");
+				outbyte(DO_TOKREPLACE);
+			  }
+			  if ($12.c_size!=0 || $12.c_time!=0) {
+				  outbyte(DO_COST);
+				  out($12.c_size);
+				  out($12.c_time);
+			  }
+			  outbyte(empatlen==0? DO_RETURN : DO_NEXTEM);
+			  fprintf(cfile,"\n");
+			  ncoderules++;
+			  maxallreg=max(maxallreg,nallreg);
+			  if (empatlen==0) { /* coercion */
+				if (tokrepllen<1 && $8==0)
+					yyerror("No replacement in coercion");
+				if (tokpatlen>1)
+					yyerror("Token pattern too long");
+				if ($8!=0) { /* stacking */
+					c1_p cp;
+					chktabsiz(nc1,MAXC1,"Coerc table 1");
+					cp = &c1coercs[nc1++];
+					cp->c1_texpno = pattokexp[1];
+					cp->c1_prop = -1;
+					cp->c1_codep = $6;
+				} else if (tokrepllen>1) { /* splitting */
+					c2_p cp;
+					chktabsiz(nc2,MAXC2,"Coerc table 2");
+					cp= &c2coercs[nc2++];
+					cp->c2_texpno = pattokexp[1];
+					cp->c2_nsplit = tokrepllen;
+					maxsplit=max(maxsplit,tokrepllen);
+					for (i=0;i<tokrepllen;i++)
+						cp->c2_repl[i] = replinst[i];
+					cp->c2_codep = $6;
+					if (nallreg>0)
+						yyerror("No allocates allowed here");
+				} else { /* one to one coercion */
+					c3_p cp;
+					chktabsiz(nc3,MAXC3,"Coerc table 3");
+					cp= &c3coercs[nc3++];
+					if (tokpatlen)
+						cp->c3_texpno = pattokexp[1];
+					else
+						cp->c3_texpno = 0;
+					if (nallreg>1)
+						yyerror("Too many allocates in coercion");
+					cp->c3_prop = nallreg==0 ? 0 : allreg[0];
+					cp->c3_repl = replinst[0];
+					cp->c3_codep = $6;
+				}
+			  }
+			}
+	| error
+	;
+empattern
+	: /* empty */
+		{ empatlen=0; }
+	| mnemlist optboolexpr
+		{ register i;
+
+		  empatexpr = $2;
+		  patbyte(0);
+		  patshort(prevind);
+		  prevind = npatbytes - 3;
+		  maxempatlen = max(empatlen,maxempatlen);
+		  pat(empatlen);
+		  for(i=1;i<=empatlen;i++)
+			patbyte(patmnem[i]);
+		  pat(empatexpr);
+		  rulecount = npatbytes;
+		  patbyte(1);   /* number of different rules with this pattern */
+		  pat(codebytes);       /* first rule */
+		}
+	| ELLIPS
+		{ pattern[rulecount]++;
+		  maxrule= max(maxrule,pattern[rulecount]);
+		  pat(codebytes);
+		}
+	;
+
+mnemlist
+	:       mnem
+		{ empatlen = 1; patmnem[empatlen] = $1; }
+	|       mnemlist mnem
+		{ chktabsiz(empatlen+1,MAXEMPATLEN,"EM pattern");
+		  patmnem[++empatlen] = $2;
+		}
+	;
+mnem    :       IDENT
+		{ if(strlen($1)!=3 || ($$=mlookup($1))==0)
+			yyerror("not an EM-mnemonic");
+		}
+	;
+
+stackpattern
+	: optnocoerc tokenexpressionlist optstack
+		{ register i;
+
+		  if (tokpatlen != 0) {
+			  outbyte(($1 ? ( $3 ? DO_XXMATCH: DO_XMATCH ) : DO_MATCH)+(tokpatlen<<5));
+			  for(i=1;i<=tokpatlen;i++) {
+				out(pattokexp[i]);
+			  }
+		  }
+		  if ($3 && tokpatlen==0 && empatlen==0) {
+			  outbyte(DO_COERC);
+		  }
+		  if ($3 && !$1 && empatlen!=0) {
+			outbyte(DO_REMOVE);
+			out(allexpno);
+		  }
+		}
+	;
+
+optnocoerc
+	: /* empty */
+		{ $$ = 0; }
+	| NOCOERC ':'
+		{ $$ = 1; }
+	;
+
+tokenexpressionlist
+	: /* empty */
+		{ tokpatlen = 0; }
+	| tokenexpressionlist tokenexpressionno
+		{ chktabsiz(tokpatlen+1,MAXPATLEN,"Token pattern");
+		  pattokexp[++tokpatlen] = $2;
+		  if (machsets[$2].set_size==0)
+			yyerror("Various sized set in tokenpattern");
+		}
+	;
+
+tokenexpressionno
+	: tokenexpression
+		{ $$ = exprlookup($1); }
+	;
+
+optstack
+	:       /* empty */
+		{ $$ = 0; }
+	|       STACK
+		{ $$ = 1; }
+	;
+
+code    :
+		{ $$ = codebytes; cchandled=ccspoiled=0; }
+	  initcode restcode
+		{ if (cchandled==0 && ccspoiled!=0) {
+			outbyte(DO_ERASE);
+			out(ccregexpr);
+		  }
+		}
+	;
+
+initcode
+	: /* empty */
+	| initcode remove
+	| initcode allocate
+	;
+remove
+	: REMOVE '(' tokenexpressionno
+		{ curtokexp = $3; }
+	  optcommabool ')'
+		{ outbyte(DO_REMOVE+ ($5!=0 ? 32 : 0));
+		  out($3);
+		  if ($5!=0) out($5);
+		}
+	| REMOVE '(' expr ')'
+		{ if ($3.expr_typ != TYPREG)
+			yyerror("Expression must be register");
+		  outbyte(DO_RREMOVE);
+		  out($3.expr_index);
+		}
+	;
+optcommabool
+	: /* empty */
+		{ $$ = 0; }
+	| ',' expr
+		{ MUST1BEBOOL($2);
+		  $$ = exp1;
+		}
+	;
+
+restcode: /* empty */
+	| restcode LSTRING expr
+		{ outbyte(DO_LOUTPUT);
+		  out(stringno($2));
+		  free($2);
+		  out($3.expr_index);
+		  ccspoiled++;
+		}
+	| restcode stringlist
+		{ int i;
+		  for(i=0;nstr>0;i++,nstr--) {
+			if (i%8==0) outbyte(DO_ROUTPUT+(nstr>7 ? 7 : nstr-1)*32);
+			out(strar[i]);
+		  }
+		  ccspoiled++;
+		}
+	| restcode RETURN
+		{ outbyte(DO_PRETURN); }
+	| restcode move
+	| restcode erase
+	| restcode NOCC
+		{ outbyte(DO_ERASE);
+		  out(ccregexpr);
+		  cchandled++;
+		}
+	| restcode SAMECC
+		{ cchandled++; }
+	| restcode SETCC '(' tokeninstanceno ')'
+		{ outbyte(DO_MOVE);
+		  out(ccinstanceno);
+		  out($4);
+		  cchandled++;
+		}
+	| restcode TEST '(' tokeninstanceno ')'
+		{ outbyte(DO_MOVE);
+		  out($4);
+		  out(ccinstanceno);
+		  ccspoiled=0;
+		}
+	;
+
+stringlist
+	: STRING
+		{ nstr=1;
+		  strar[0]=stringno($1);
+		  free($1);
+		}
+	| stringlist STRING
+		{ chktabsiz(nstr,MAXNSTR,"Consecutiv strings");
+		  strar[nstr++] = stringno($2);
+		  free($2);
+		}
+	;
+
+move
+	: MOVE '(' tokeninstanceno ',' tokeninstanceno ')'
+		{ outbyte(DO_MOVE);
+		  out($3);
+		  out($5);
+		}
+	;
+
+erase
+	: ERASE '(' expr ')'
+		{ outbyte(DO_ERASE);
+		  out($3.expr_index);
+		  if($3.expr_typ != TYPREG)
+			yyerror("Bad argument of erase");
+		}
+	;
+
+allocate
+	: ALLOCATE { dealflag=0; } '(' alloclist ')'
+		{ if (dealflag)
+			outbyte(DO_REALLOCATE);
+		}
+	;
+
+
+alloclist
+	: allocel
+	| alloclist optcomma allocel
+	;
+
+allocel
+	: tokeninstanceno       /* deallocate */
+		{ outbyte(DO_DEALLOCATE);
+		  out($1);
+		  dealflag++;
+		}
+	| PIDENT
+		{ allreg[nallreg++] = $1->i_i.i_prpno;
+		  outbyte(DO_ALLOCATE);
+		  out($1->i_i.i_prpno);
+		}
+	| PIDENT '=' tokeninstanceno
+		{ allreg[nallreg++] = $1->i_i.i_prpno;
+		  outbyte(DO_ALLOCATE+32);
+		  out($1->i_i.i_prpno);
+		  out($3);
+		}
+	;
+
+stackreplacement
+	: /* empty */
+		{ $$=0; }
+	| STACK
+		{ $$=1; }
+	| '{' STACK '}'
+		{ $$=1; }
+	| stackrepllist
+		{ $$=0; }
+	;
+stackrepllist
+	: tokeninstanceno
+		{ tokrepllen=1; replinst[0] = $1; }
+	| stackrepllist tokeninstanceno
+		{ chktabsiz(tokrepllen+1,MAXPATLEN,"Stack replacement");
+		  replinst[tokrepllen++] = $2;
+		}
+	;
+
+emreplacement
+	: /* empty, normal case */
+	| emrepllist
+	;
+emrepllist
+	: mnem optexpr
+		{ emrepllen=1;
+		  replmnem[0]=$1;
+		  replexpr[0]=$2.expr_index;
+		}
+	| emrepllist mnem optexpr
+		{ chktabsiz(emrepllen+1,MAXEMPATLEN,"EM replacement");
+		  replmnem[emrepllen]=$2;
+		  replexpr[emrepllen]=$3.expr_index;
+		  emrepllen++;
+		}
+	;
+
+cost    : /* empty */
+		{ $$.c_size = $$.c_time = 0;
+		}
+	| '(' expr ',' expr ')'
+		{ MUST2BEINT($2,$4);
+		  $$.c_size = exp1;
+		  $$.c_time = exp2;
+		}
+	| cost '+' '%' '[' tokargno ']'
+		{ $$.c_size = lookup(1,EX_PLUS,$1.c_size,
+					lookup(0,EX_COST,$5,0));
+		  $$.c_time = lookup(1,EX_PLUS,$1.c_time,
+					lookup(0,EX_COST,$5,1));
+		}
+	;
+
+movesection
+	: MOVEHEAD movedefs
+	;
+
+movedefs
+	: movedef
+	| movedefs movedef
+	;
+
+movedef
+	: '(' tokenexpressionno
+		{ curtokexp = $2; }
+	  optboolexpr ',' tokenexpressionno
+		{ curtokexp = $6;
+		  pattokexp[1] = $2;
+		  pattokexp[2] = $6;
+		  tokpatlen=2;
+		}
+	  optboolexpr ',' code optcommacost ')'
+		{ register move_p mp;
+
+		  outbyte(DO_RETURN);
+		  fprintf(cfile,"\n");
+		  chktabsiz(nmoves,NMOVES,"Move definition table");
+		  mp = &machmoves[nmoves++];
+		  mp->m_set1 = $2;
+		  mp->m_expr1= $4;
+		  mp->m_set2 = $6;
+		  mp->m_expr2= $8;
+		  mp->m_cindex=$10;
+		  mp->m_cost = $11;
+		}
+	| error
+	;
+
+testsection
+	: /* empty */
+	| TESTHEAD testdefs
+	;
+
+testdefs: testdef
+	| testdefs testdef
+	;
+
+testdef : '(' tokenexpressionno
+		{ curtokexp = $2;
+		  pattokexp[1] = $2;
+		  pattokexp[2] = cocosetno;
+		  tokpatlen=2;
+		}
+	  optboolexpr ',' code optcommacost ')'
+		{ register move_p mp;
+
+		  outbyte(DO_RETURN);
+		  fprintf(cfile,"\n");
+		  chktabsiz(nmoves,NMOVES,"Move definition table(tests)");
+		  mp = &machmoves[nmoves++];
+		  mp->m_set1 = $2;
+		  mp->m_expr1 = $4;
+		  mp->m_set2 = cocosetno;
+		  mp->m_expr2 = 0;
+		  mp->m_cindex = $6;
+		  mp->m_cost = $7;
+		}
+	;
+
+stacksection
+	: STACKHEAD stackdefs
+	| /* empty */
+	;
+stackdefs
+	: stackdef
+	| stackdefs stackdef
+	;
+stackdef
+	: '(' tokenexpressionno
+		{ curtokexp = $2;
+		  pattokexp[1] = $2;
+		  tokpatlen=1;
+		}
+	  optboolexpr ',' optprop ',' code optcommacost ')'
+		{ register c1_p cp;
+
+		  outbyte(DO_TOKREPLACE);
+		  outbyte(DO_RETURN);
+		  fprintf(cfile,"\n");
+		  chktabsiz(nc1,MAXC1,"Stacking table");
+		  cp = &c1coercs[nc1++];
+		  cp->c1_texpno = $2;
+		  cp->c1_expr = $4;
+		  cp->c1_prop = $6;
+		  cp->c1_codep = $8;
+		  cp->c1_cost = $9;
+		}
+	;
+
+optprop
+	: /* empty */
+		{ $$ = -1; }
+	| PIDENT 
+		{ $$ = $1->i_i.i_prpno; }
+	;
+
+optcommacost
+	: /* empty */
+		{ $$.c_size = 0; $$.c_time = 0;}
+	| ',' cost
+		{ $$ = $2; }
+	;
+
+list1   : /* empty */
+		{ $$ = 0; }
+	| optcomma IDENT list1
+		{ $$=(list1) myalloc(sizeof(struct list1str));
+		  $$->l1next = $3;
+		  $$->l1name = $2;
+		}
+	;
+optcomma: /* nothing */
+	| ','
+	;
+emargno : NUMBER
+		{ if ($1<1 || $1>empatlen)
+			yyerror("Number after $ out of range");
+		  $$ = $1;
+		}
+	;
+tokargno
+	: NUMBER
+		{ if ($1<1 || $1>tokpatlen)
+			yyerror("Number within %[] out of range");
+		  $$ = $1;
+		}
+	;
+expr    : '$' emargno
+		{ $$.expr_index = lookup(0,EX_ARG,$2,0); $$.expr_typ = argtyp(patmnem[$2]);
+		}
+	| NUMBER
+		{ $$.expr_index = lookup(0,EX_CON,(int)($1&0177777),(int)($1>>16));
+		  $$.expr_typ = TYPINT;
+		}
+	| STRING
+		{ $$.expr_index = lookup(0,EX_STRING,strlookup($1),0);
+		  $$.expr_typ = TYPSTR;
+		}
+	| RIDENT
+		{ $$.expr_index = lookup(0,EX_REG,$1->i_i.i_regno,0);
+		  $$.expr_typ = TYPREG;
+		}
+	| '%' '[' tokargno '.' IDENT ']'
+		{ $$.expr_index = lookup(0,EX_TOKFIELD,$3,
+		     findstructel(pattokexp[$3],$5,&$$.expr_typ));
+		}
+	| '%' '[' tokargno subreg ']'
+		{ chkregexp(pattokexp[$3]);
+		  $$.expr_index = lookup(0,EX_SUBREG,$3,$4);
+		  $$.expr_typ = TYPREG;
+		}
+	| '%' '[' LCASELETTER subreg ']'
+		{ if ($3 >= 'a'+nallreg)
+			yyerror("Bad letter in %[x] construct");
+		  $$.expr_index = lookup(0,EX_ALLREG,$3-'a'+1,$4);
+		  $$.expr_typ = TYPREG;
+		}
+	| '%' '[' IDENT ']'
+		{ $$.expr_index = lookup(0,EX_TOKFIELD,0,
+		     findstructel(curtokexp,$3,&$$.expr_typ));
+		}
+	| TOSTRING '(' expr ')'
+		{ MUST1BEINT($3);
+		  $$.expr_index = lookup(0,EX_TOSTRING,exp1,0);
+		  $$.expr_typ = TYPSTR;
+		}
+	| DEFINED '(' expr ')'
+		{ $$.expr_index = lookup(0,EX_DEFINED,$3.expr_index,0);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| SAMESIGN '(' expr ',' expr ')'
+		{ MUST2BEINT($3,$5);
+		  $$.expr_index = lookup(1,EX_SAMESIGN,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| SFIT '(' expr ',' expr ')'
+		{ MUST2BEINT($3,$5);
+		  $$.expr_index = lookup(0,EX_SFIT,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| UFIT '(' expr ',' expr ')'
+		{ MUST2BEINT($3,$5);
+		  $$.expr_index = lookup(0,EX_UFIT,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| ROM '(' emargno ',' NUMBER ')'
+		{ if ($5<1 || $5>3)
+			yyerror("Second argument of rom must be >=1 and <=3");
+		  $$.expr_index = lookup(0,EX_ROM,$3-1,$5-1);
+		  $$.expr_typ = TYPINT;
+		}
+	| LOWW '(' emargno ')'
+		{
+		  $$.expr_index = lookup(0,EX_LOWW,$3-1,0);
+		  $$.expr_typ = TYPINT;
+		}
+	| HIGHW '(' emargno ')'
+		{
+		  $$.expr_index = lookup(0,EX_HIGHW,$3-1,0);
+		  $$.expr_typ = TYPINT;
+		}
+	| '(' expr ')'
+		{ $$ = $2; }
+	| expr CMPEQ expr
+		{ switch(commontype($1,$3)) {
+		  case TYPINT:
+			$$.expr_index = lookup(1,EX_NCPEQ,$1.expr_index,$3.expr_index);
+			break;
+		  case TYPSTR:
+			$$.expr_index = lookup(1,EX_SCPEQ,$1.expr_index,$3.expr_index);
+			break;
+		  case TYPREG:
+			$$.expr_index = lookup(1,EX_RCPEQ,$1.expr_index,$3.expr_index);
+			break;
+		  }
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr CMPNE expr
+		{ switch(commontype($1,$3)) {
+		  case TYPINT:
+			$$.expr_index = lookup(1,EX_NCPNE,$1.expr_index,$3.expr_index);
+			break;
+		  case TYPSTR:
+			$$.expr_index = lookup(1,EX_SCPNE,$1.expr_index,$3.expr_index);
+			break;
+		  case TYPREG:
+			$$.expr_index = lookup(1,EX_RCPNE,$1.expr_index,$3.expr_index);
+			break;
+		  }
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr CMPGT expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_NCPGT,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr CMPGE expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_NCPGE,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr CMPLT expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_NCPLT,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr CMPLE expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_NCPLE,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr OR2 expr
+		{ MUST2BEBOOL($1,$3);
+		  $$.expr_index = lookup(0,EX_OR2,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr AND2 expr
+		{ MUST2BEBOOL($1,$3);
+		  $$.expr_index = lookup(0,EX_AND2,exp1,exp2);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| expr '+' expr
+		{ switch(commontype($1,$3)) {
+		  case TYPINT:
+			$$.expr_index = lookup(1,EX_PLUS,$1.expr_index,$3.expr_index);
+			break;
+		  case TYPSTR:
+			$$.expr_index = lookup(0,EX_CAT,$1.expr_index,$3.expr_index);
+			break;
+		  default:
+			yyerror("Bad types");
+		  }
+		  $$.expr_typ = $1.expr_typ;
+		}
+	| expr '-' expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_MINUS,exp1,exp2);
+		  $$.expr_typ = TYPINT;
+		}
+	| expr '*' expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(1,EX_TIMES,exp1,exp2);
+		  $$.expr_typ = TYPINT;
+		}
+	| expr '/' expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_DIVIDE,exp1,exp2);
+		  $$.expr_typ = TYPINT;
+		}
+	| expr '%' expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_MOD,exp1,exp2);
+		  $$.expr_typ = TYPINT;
+		}
+	| expr LSHIFT expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_LSHIFT,exp1,exp2);
+		  $$.expr_typ = TYPINT;
+		}
+	| expr RSHIFT expr
+		{ MUST2BEINT($1,$3);
+		  $$.expr_index = lookup(0,EX_RSHIFT,exp1,exp2);
+		  $$.expr_typ = TYPINT;
+		}
+	| NOT expr
+		{ MUST1BEBOOL($2);
+		  $$.expr_index = lookup(0,EX_NOT,exp1,0);
+		  $$.expr_typ = TYPBOOL;
+		}
+	| COMP expr
+		{ MUST1BEINT($2);
+		  $$.expr_index = lookup(0,EX_COMP,exp1,0);
+		  $$.expr_typ = TYPINT;
+		}
+	| INREG '(' expr ')'
+		{ MUST1BEINT($3);
+		  $$.expr_index = lookup(0,EX_INREG,exp1,0);
+		  $$.expr_typ = TYPINT;
+		}
+	| REGVAR '(' expr ')'
+		{ MUST1BEINT($3);
+		  $$.expr_index = lookup(0,EX_REGVAR,exp1,0);
+		  $$.expr_typ = TYPREG;
+		}
+/*
+	| '-' expr %prec UMINUS
+		{ MUST1BEINT($2);
+		  $$.expr_index = lookup(0,EX_UMINUS,exp1,0);
+		  $$.expr_typ = TYPINT;
+		}
+*/
+	;
+
+subreg  : /* empty */
+		{ $$=0; }
+	| '.' NUMBER
+		{ $$=$2; }
+	;
+
+optboolexpr
+	: /* empty */
+		{ $$ = 0; }
+	| expr
+		{ MUST1BEBOOL($1);
+		  $$=exp1;
+		}
+	;
+optexpr
+	: /* empty */
+		{ $$.expr_typ=0;
+		  $$.expr_index=0;
+		}
+	| expr
+	;
+
+tokeninstanceno
+	: tokeninstance
+		{ $$ = instno($1); }
+	;
+
+tokeninstance
+	: '%' '[' tokargno subreg ']'
+		{ register i;
+
+		  if ($4!=0)
+			  chkregexp(pattokexp[$3]);
+		  $$.in_which = IN_COPY;
+		  $$.in_info[0] = $3;
+		  $$.in_info[1] = $4;
+		  for (i=2;i<TOKENSIZE;i++)
+			$$.in_info[i] = 0;
+		}
+	| '%' '[' tokargno '.' IDENT ']'
+		{ int typ;
+		  register i;
+		  $$.in_which = IN_COPY;
+		  $$.in_info[0] = $3;
+		  $$.in_info[1] = findstructel(pattokexp[$3],$5,&typ);
+		  if (typ != TYPREG)
+			yyerror("Must be register");
+		  for (i=2;i<TOKENSIZE;i++)
+			$$.in_info[i] = 0;
+		}
+	| RIDENT
+		{ register i;
+		  $$.in_which = IN_RIDENT;
+		  $$.in_info[0] = $1->i_i.i_regno;
+		  for (i=1;i<TOKENSIZE;i++)
+			$$.in_info[i] = 0;
+		}
+	| REGVAR '(' expr ')'
+		{ register i;
+		  MUST1BEINT($3);
+		  $$.in_which = IN_REGVAR;
+		  $$.in_info[0] = exp1;
+		  for (i=1;i<TOKENSIZE;i++)
+			$$.in_info[i] = 0;
+		}
+	| '%' '[' LCASELETTER subreg ']'
+		{ register i;
+		  if ($3 >= 'a'+nallreg)
+			yyerror("Bad letter in %[x] construct");
+		  $$.in_which = IN_ALLOC;
+		  $$.in_info[0] = $3-'a';
+		  $$.in_info[1] = $4;
+		  for (i=2;i<TOKENSIZE;i++)
+			$$.in_info[i] = 0;
+		}
+	| '{' TIDENT attlist '}'
+		{ register i;
+		  $$.in_which = IN_DESCR;
+		  $$.in_info[0] = $2->i_i.i_tokno;
+		  for(i=0;i<narexp;i++) {
+			if (arexp[i].expr_typ !=
+			      machtokens[$2->i_i.i_tokno].t_fields[i].t_type)
+				yyerror("Attribute %d has wrong type",i+1);
+			$$.in_info[i+1] = arexp[i].expr_index;
+		  }
+		  for (i=narexp+1;i<TOKENSIZE;i++) {
+			if (machtokens[$2->i_i.i_tokno].t_fields[i-1].t_type!=0)
+				yyerror("Too few attributes");
+			$$.in_info[i] = 0;
+		  }
+		}
+	;
+
+attlist
+	: /* empty */
+		{ narexp = 0; }
+	| attlist ',' expr
+		{ arexp[narexp++] = $3; }
+	;
+
+%%
+
+char * myalloc(n) {
+	register char *p;
+
+	p= (char*) malloc(n);
+	if (p==0) {
+		yyerror("Out of core");
+		exit(1);
+	}
+	return(p);
+}
+
+tstint(e) expr_t e; {
+
+	if(e.expr_typ != TYPINT)
+		yyerror("Must be integer expression");
+}
+
+tstbool(e) expr_t e; {
+
+	if(e.expr_typ != TYPBOOL)
+		yyerror("Must be boolean expression");
+}
+
+structsize(s) register list2 s; {
+	register list1 l;
+	register sum;
+
+	sum = 0;
+	while ( s != 0 ) {
+		l = s->l2list->l1next;
+		while ( l != 0 ) {
+			sum++;
+			l = l->l1next;
+		}
+		s = s->l2next;
+	}
+	return(sum);
+}
+
+list2 lookstruct(ll) list2 ll; {
+	list3 l3;
+	list2 l21,l22;
+	list1 l11,l12;
+
+	for (l3=structpool;l3 != 0;l3=l3->l3next) {
+		for (l21=l3->l3list,l22=ll;l21!=0 && l22!=0;
+		     l21=l21->l2next,l22=l22->l2next) {
+			for(l11=l21->l2list,l12=l22->l2list;
+			    l11!=0 && l12!=0 && strcmp(l11->l1name,l12->l1name)==0;
+			    l11=l11->l1next,l12=l12->l1next)
+				;
+			if (l11!=0 || l12!=0)
+				goto contin;
+		}
+		if(l21==0 && l22==0)
+			return(l3->l3list);
+		contin:;
+	}
+	l3 = (list3) myalloc(sizeof(struct list3str));
+	l3->l3next=structpool;
+	l3->l3list=ll;
+	structpool=l3;
+	return(ll);
+}
+
+instno(inst) inst_t inst; {
+	register i,j;
+
+	for(i=1;i<narinstance;i++) {
+		if (arinstance[i].in_which != inst.in_which)
+			continue;
+		for(j=0;j<TOKENSIZE;j++)
+			if(arinstance[i].in_info[j] != inst.in_info[j])
+				goto cont;
+		return(i);
+	cont:;
+	}
+	chktabsiz(narinstance,MAXINSTANCE,"Instance table");
+	arinstance[narinstance] = inst;
+	return(narinstance++);
+}
+
+string scopy(s) string s; {
+	register string t;
+
+	t = (char *) myalloc(strlen(s)+1);
+	strcpy(t,s);
+	return(t);
+}
+
+strlookup(s) string s; {
+	register i;
+
+	for(i=0;i<ncodestrings;i++)
+		if(strcmp(s,codestrings[i])==0)
+			return(i);
+	chktabsiz(ncodestrings,MAXSTRINGS,"string table");
+	codestrings[ncodestrings] = scopy(s);
+	return(ncodestrings++);
+}
+
+stringno(s) register string s; {
+	char buf[256];
+	register char *p=buf;
+
+	while(*s != 0) switch(*s) {
+	default:
+		*p++ = *s++;
+		continue;
+	case '$':
+		s++;
+		switch(*s) {
+		default:
+			yyerror("Bad character after $ in codestring");
+		case '$':
+			*p++ = *s++;
+			continue;
+		case '1':
+		case '2':
+		case '3':
+		case '4':
+		case '5':
+		case '6':
+		case '7':
+		case '8':
+		case '9':
+			*p++ = argtyp(patmnem[*s-'0']) == TYPINT ?
+				PR_EMINT : PR_EMSTR;
+			*p++ = *s++ -'0';
+			continue;
+		}
+	case '%':
+		s++;
+		if (*s != '[') {
+			if(*s == '%') {
+				*p++ = *s++;
+				continue;
+			} else
+				yyerror("Bad character following %% in codestring");
+		} else
+			s++;
+		if(isdigit(*s)) {
+			int num;
+			num = *s++ - '0';
+			if (num<1 || num>tokpatlen)
+				yyerror("Number within %[] out of range");
+			if (*s == ']') {
+				s++;
+				*p++ = PR_TOK;
+				*p++ = num;
+			} else if (*s++ != '.')
+				yyerror("Bad character following %%[digit in codestring");
+			else {
+				char field[256];
+				register char *f=field;
+				int type,offset;
+
+				while( *s != ']' && *s != 0)
+					*f++ = *s++;
+				*f++ = 0;
+				if (*s != ']')
+					yyerror("Unterminated %[] construction in codestring");
+				else
+					s++;
+				if (isdigit(field[0])) {
+					chkregexp(pattokexp[num]);
+					*p++ = PR_SUBREG;
+					*p++ = num;
+					*p++ = atoi(field);
+				} else {
+					offset = findstructel(pattokexp[num],field,&type);
+					*p++ = PR_TOKFLD;
+					*p++ = num;
+					*p++ = offset;
+				}
+			}
+		} else if (*s >= 'a' && *s < 'a'+nallreg) {
+			int reg,subreg;
+			reg = *s++ -'a'+1;
+			if(*s == ']')
+				subreg = 255;
+			else {
+				if (*s != '.')
+					yyerror("Bad character following %%[x in codestring");
+				s++;
+				if(!isdigit(*s))
+					yyerror("Bad character following %%[x. in codestring");
+				subreg = *s - '0';
+				s++;
+				if(*s != ']')
+					yyerror("Bad character following %%[x.y in codestring");
+			}
+			s++;
+			*p++ = PR_ALLREG;
+			*p++ = reg;
+			*p++ = subreg;
+		} else
+			yyerror("Bad character following %%[ in codestring");
+	}
+	*p++ = 0;
+	return(strlookup(buf));
+}
+
+tabovf(tablename) string tablename; {
+	char buf[256];
+
+	sprintf(buf,"%s overflow",tablename);
+	yyerror(buf);
+	exit(-1);
+}
+
+main(argc,argv) char *argv[]; {
+
+	if (argc!=1) {
+		fprintf(stderr,"%s is a filter, don't use arguments\n",argv[0]);
+		exit(-1);
+	}
+	inithash();
+	initio();
+	inittables();
+	yyparse();
+	if (nerrors==0) {
+		compueq();
+		hashpatterns();
+		finishio();
+		verbose();
+	}
+	debug();
+	exit(nerrors);
+}
+
+lookup(comm,operator,lnode,rnode) {
+	register node_p p;
+
+	for (p=nodes+1;p<lastnode;p++) {
+		if (p->ex_operator != operator)
+			continue;
+		if (!(p->ex_lnode == lnode && p->ex_rnode == rnode ||
+		    comm && p->ex_lnode == rnode && p->ex_rnode == lnode))
+			continue;
+		return(p-nodes);
+	}
+	if (lastnode >= &nodes[MAXNODES])
+		yyerror("node table overflow");
+	lastnode++;
+	p->ex_operator = operator;
+	p->ex_lnode = lnode;
+	p->ex_rnode = rnode;
+	return(p-nodes);
+}
+
+compueq() {
+	register i,j;
+
+	for (i=1;i<nmachregs;i++) {
+		for (j=1;j<i;j++)
+			if (eqregclass(i,j)) {
+				stregclass[i] = stregclass[j];
+				break;
+			}
+		if (j==i)
+			stregclass[i] = nregclasses++;
+	}
+}
+
+eqregclass(r1,r2) {
+	register reginfo rp1,rp2;
+	register i;
+	short regbits[(MAXREGS+15)>>4];
+	int member;
+
+	rp1 = machregs[r1]; rp2 = machregs[r2];
+	for (i=0;i<((nprops+15)>>4);i++)
+		if (rp1->rprop[i] != rp2->rprop[i])
+			return(0);
+	for (i=0;i<((MAXREGS+15)>>4);i++)
+		regbits[i] = 0;
+	for (i=0;i<maxmembers;i++) {
+		if (member = rp1->rmembers[i])
+			regbits[member>>4] |= (1<<(member&017));
+	}
+	for (i=0;i<maxmembers;i++) {
+		member = rp2->rmembers[i];
+		if (regbits[member>>4]&(1<<(member&017)))
+			return(0);
+	}
+	return(1);
+}
+
+unsigned hash(name) register string name; {
+	register unsigned sum;
+	register i;
+
+	for (sum=i=0;*name;i+=3)
+		sum ^= (*name++)<<(i&07);
+	return(sum);
+}
+
+ident_p ilookup(name,enterf) string name; int enterf; {
+	register ident_p p,*pp;
+
+	pp = &identtab[hash(name)%ITABSIZE];
+	while (*pp != 0) {
+		if (strcmp((*pp)->i_name,name)==0)
+			if (enterf != ENTER)
+				return(*pp);
+			else
+				yyerror("Multiply defined symbol");
+		pp = &(*pp)->i_next;
+	}
+	if (enterf == LOOKUP)
+		yyerror("Undefined symbol");
+	if (enterf == JUSTLOOKING)
+		return(0);
+	p = *pp = (ident_p) myalloc(sizeof(ident_t));
+	p->i_name = name;
+	p->i_next = 0;
+	p->i_type = 0;
+	return(p);
+}
+
+initio() {
+
+	if ((cfile=fopen("tables.c","w"))==NULL) {
+		fprintf(stderr,"Can't create tables.c\n");
+		exit(-1);
+	}
+	if ((hfile=fopen("tables.h","w"))==NULL) {
+		fprintf(stderr,"Can't create tables.h\n");
+		exit(-1);
+	}
+	fprintf(cfile,"#include \"param.h\"\n");
+	fprintf(cfile,"#include \"tables.h\"\n");
+	fprintf(cfile,"#include \"types.h\"\n");
+	fprintf(cfile,"#include <cg_pattern.h>\n");
+	fprintf(cfile,"#include \"data.h\"\n");
+	fprintf(cfile,"\nbyte coderules[] = {\n");
+	patbyte(0);
+}
+
+exprlookup(sett) set_t sett; {
+	register i,j,ok;
+
+	for(i=0;i<nmachsets;i++) {
+		ok= (sett.set_size == machsets[i].set_size);
+		for(j=0;j<SETSIZE;j++) {
+			if (sett.set_val[j] == machsets[i].set_val[j])
+				continue;
+			ok=0;
+			break;
+		}
+		if (ok)
+			return(i);
+	}
+	chktabsiz(nmachsets,MAXSETS,"Expression table");
+	machsets[nmachsets] = sett;
+	return(nmachsets++);
+}
+
+inittables() {
+	register reginfo r;
+	register i;
+	inst_t inst;
+	set_t sett;
+
+	nodes[0].ex_operator=EX_CON;
+	nodes[0].ex_lnode=0;
+	nodes[0].ex_rnode=0;
+	cocopropno=nprops++;
+	r=(reginfo)myalloc(sizeof(struct reginfo));
+	r->rname = "cc reg";
+	r->rrepr = "CC";
+	r->rsize = -1;
+	r->rregvar= -1;
+	for(i=0;i<MAXMEMBERS;i++)
+		r->rmembers[i] = 0;
+	for(i=0;i<PROPSETSIZE;i++)
+		r->rprop[i] = 0;
+	r->rprop[cocopropno>>4] |= (1<<(cocopropno&017));
+	chktabsiz(nmachregs,MAXREGS,"Register table");
+	machregs[nmachregs++]  = r;
+	inst.in_which = IN_RIDENT;
+	inst.in_info[0] = nmachregs-1;
+	for(i=1;i<TOKENSIZE;i++)
+		inst.in_info[i]=0;
+	ccinstanceno=instno(inst);
+	ccregexpr=lookup(0,EX_REG,nmachregs-1,0);
+	sett.set_size=0;
+	for (i=0;i<SETSIZE;i++)
+		sett.set_val[i]=0;
+	sett.set_val[nmachregs>>4] |= (01<<(nmachregs&017));
+	cocosetno=exprlookup(sett);
+}
+
+outregs() {
+	register i,j,k;
+	static short rset[(MAXREGS+15)>>4];
+	int t,ready;
+
+	fprintf(cfile,"char stregclass[] = {\n");
+	for (i=0;i<nmachregs;i++)
+		fprintf(cfile,"\t%d,\n",stregclass[i]);
+	fprintf(cfile,"};\n\nstruct reginfo machregs[] = {\n{0},\n");
+	for (i=1;i<nmachregs;i++) {
+		fprintf(cfile,"{%d,%d",strlookup(machregs[i]->rrepr),
+			machregs[i]->rsize);
+		if (maxmembers!=0) {
+			fprintf(cfile,",{");
+			for(j=0;j<maxmembers;j++)
+				fprintf(cfile,"%d,",machregs[i]->rmembers[j]);
+			/* now compute and print set of registers
+			 * that clashes with this register.
+			 * A register clashes with al its children (and theirs)
+			 * and with all their parents.
+			 */
+			for (j=0;j<((MAXREGS+15)>>4);j++)
+				rset[j]=0;
+			rset[i>>4] |= (1<<(i&017));
+			do {
+			    ready=1;
+			    for (j=1;j<nmachregs;j++)
+				if (rset[j>>4]&(1<<(j&017)))
+				    for (k=0;k<maxmembers;k++)
+					if ((t=machregs[j]->rmembers[k])!=0) {
+					    if ((rset[t>>4]&(1<<(t&017)))==0)
+						ready=0;
+					    rset[t>>4] |= (1<<(t&017));
+					}
+			} while (!ready);
+			do {
+			    ready=1;
+			    for (j=1;j<nmachregs;j++)
+				for (k=0;k<maxmembers;k++)
+				    if ((t=machregs[j]->rmembers[k])!=0)
+					if (rset[t>>4]&(1<<(t&017))) {
+						if (rset[j>>4]&(1<<(j&017))==0)
+						    ready=0;
+						rset[j>>4] |= (1<<(j&017));
+					}
+			} while (!ready);
+			fprintf(cfile,"},{");
+			for (j=0;j<((nmachregs+15)>>4);j++)
+				fprintf(cfile,"%d,",rset[j]);
+			fprintf(cfile,"}");
+		}
+		if (machregs[i]->rregvar>=0)
+			fprintf(cfile,",1");
+		fprintf(cfile,"},\n");
+	}
+	fprintf(cfile,"};\n\n");
+}
+
+finishio() {
+	register i;
+	register node_p np;
+	int j;
+	int setsize;
+	register move_p mp;
+
+	fprintf(cfile,"};\n\n");
+	if (wsize>0)
+		fprintf(hfile,"#define EM_WSIZE %d\n",wsize);
+	else
+		yyerror("Wordsize undefined");
+	if (psize>0)
+		fprintf(hfile,"#define EM_PSIZE %d\n",psize);
+	else
+		yyerror("Pointersize undefined");
+	if (bsize>=0)
+		fprintf(hfile,"#define EM_BSIZE %d\n",bsize);
+	else
+		fprintf(hfile,"extern int EM_BSIZE;\n");
+	if (fmt!=0)
+		fprintf(hfile,"#define WRD_FMT \"%s\"\n",fmt);
+	fprintf(hfile,"#define MAXALLREG %d\n",maxallreg);
+	setsize = (nmachregs+1 + nmachtokens + 15)>>4;
+	fprintf(hfile,"#define SETSIZE %d\n",setsize);
+	fprintf(hfile,"#define NPROPS %d\n",nprops);
+	fprintf(hfile,"#define NREGS %d\n",nmachregs);
+	fprintf(hfile,"#define REGSETSIZE %d\n",(nmachregs+15)>>4);
+	fprintf(hfile,"#define TOKENSIZE %d\n",maxtokensize);
+	fprintf(hfile,"#define MAXMEMBERS %d\n",maxmembers);
+	fprintf(hfile,"#define LONGESTPATTERN %d\n",maxempatlen);
+	fprintf(hfile,"#define MAXRULE %d\n",maxrule);
+	fprintf(hfile,"#define NMOVES %d\n",nmoves);
+	fprintf(hfile,"#define NC1 %d\n",nc1);
+	if (nc2) {
+		assert(maxsplit!=0);
+		fprintf(hfile,"#define NC2 %d\n",nc2);
+		fprintf(hfile,"#define MAXSPLIT %d\n",maxsplit);
+	}
+	fprintf(hfile,"#define NC3 %d\n",nc3);
+	outregs();
+	fprintf(cfile,"tkdef_t tokens[] = {\n");
+	for(i=0;i<nmachtokens;i++) {
+		fprintf(cfile,"{%d,{%d,%d},{",machtokens[i].t_size,
+				machtokens[i].t_cost.c_size,
+				machtokens[i].t_cost.c_time);
+		for(j=0;j<maxtokensize;j++)
+			fprintf(cfile,"%d,",machtokens[i].t_fields[j].t_type);
+		fprintf(cfile,"},%d},\n",machtokens[i].t_format);
+	}
+	fprintf(cfile,"};\n\nnode_t enodes[] = {\n");
+	for(np=nodes;np<lastnode;np++)
+		fprintf(cfile,"{%d,%d,%d},\n",np->ex_operator,np->ex_lnode,
+				np->ex_rnode);
+	fprintf(cfile,"};\n\nstring codestrings[] = {\n");
+	for(i=0;i<ncodestrings;i++) {
+		register char *p;
+		p=codestrings[i];
+		fprintf(cfile,"\t\"");
+		while (*p) {
+			fprintf(cfile, !isascii(*p) || iscntrl(*p) ? "\\%03o" : "%c", (*p)&BMASK);
+			p++;
+		}
+		fprintf(cfile,"\",\n");
+	}
+	fprintf(cfile,"};\n\nset_t machsets[] = {\n");
+	for(i=0;i<nmachsets;i++) {
+		fprintf(cfile,"{%d,{",machsets[i].set_size);
+		for(j=0;j<setsize;j++)
+			fprintf(cfile,"0%o,",machsets[i].set_val[j]);
+		fprintf(cfile,"}},\n");
+	}
+	fprintf(cfile,"};\n\ninst_t tokeninstances[] = {\n");
+	for(i=0;i<narinstance;i++) {
+		fprintf(cfile,"{ %d, {",arinstance[i].in_which);
+		for(j=0;j<=maxtokensize;j++)
+			fprintf(cfile,"%d,",arinstance[i].in_info[j]);
+		fprintf(cfile,"}},\n");
+	}
+	fprintf(cfile,"};\n\nmove_t moves[] = {\n");
+	for (i=0;i<nmoves;i++) {
+		mp = &machmoves[i];
+		fprintf(cfile,"{%d,%d,%d,%d,%d,{%d,%d}},\n",
+			mp->m_set1, mp->m_expr1,
+			mp->m_set2, mp->m_expr2,
+			mp->m_cindex,
+			mp->m_cost.c_size,mp->m_cost.c_time);
+	}
+	fprintf(cfile,"};\n\nbyte pattern[] = {\n");
+	for (i=0;i<npatbytes;i++) {
+		fprintf(cfile,"%3d,",pattern[i]&BMASK);
+		if ((i%10)==9)
+			fprintf(cfile,"\n");
+	}
+	fprintf(cfile,"\n};\n\nint pathash[256] = {\n");
+	for(i=0;i<256;i++) {
+		fprintf(cfile,"%6d,",pathash[i]);
+		if((i&07)==07)
+			fprintf(cfile,"\n");
+	}
+	fprintf(cfile,"};\n\nc1_t c1coercs[] = {\n");
+	for (i=0;i<nc1;i++)
+		fprintf(cfile,"{%d,%d,%d,%d,{%d,%d}},\n",
+			c1coercs[i].c1_texpno,
+			c1coercs[i].c1_expr,
+			c1coercs[i].c1_prop,
+			c1coercs[i].c1_codep,
+			c1coercs[i].c1_cost.c_size,
+			c1coercs[i].c1_cost.c_time);
+	if (nc2)
+		fprintf(cfile,"};\n\nc2_t c2coercs[] = {\n");
+	for (i=0;i<nc2;i++) {
+		fprintf(cfile,"{%d,%d,{",
+			c2coercs[i].c2_texpno,
+			c2coercs[i].c2_nsplit);
+		for (j=0;j<maxsplit;j++)
+			fprintf(cfile,"%d,",c2coercs[i].c2_repl[j]);
+		fprintf(cfile,"},%d},\n",c2coercs[i].c2_codep);
+	}
+	fprintf(cfile,"};\n\nc3_t c3coercs[] = {\n");
+	for (i=0;i<nc3;i++)
+		fprintf(cfile,"{%d,%d,%d,%d},\n",
+			c3coercs[i].c3_texpno,
+			c3coercs[i].c3_prop,
+			c3coercs[i].c3_repl,
+			c3coercs[i].c3_codep);
+	fprintf(cfile,"};\n\n");
+	for (i=0;i<nprops;i++) {
+		fprintf(cfile,"struct reginfo *rlist%02d[] = {\n",i);
+		for (j=2;j<=nmachregs;j++) {
+			if (machregs[j-1]->rregvar<0 && 
+			    (machprops[i].propset.set_val[j>>4]&(1<<(j&017))))
+				fprintf(cfile,"\t&machregs[%d],\n",j-1);
+		}
+		fprintf(cfile,"\t0\n};\n");
+	}
+	fprintf(cfile,"struct reginfo **reglist[] = {\n");
+	for (i=0;i<nprops;i++) {
+		fprintf(cfile,"\trlist%02d,\n",i);
+	}
+	fprintf(cfile,"};\n");
+	fprintf(cfile,"unsigned cc1 = %u;\n",cc1);
+	fprintf(cfile,"unsigned cc2 = %u;\n",cc2);
+	fprintf(cfile,"unsigned cc3 = %u;\n",cc3);
+	fprintf(cfile,"unsigned cc4 = %u;\n",cc4);
+	if (rvused)
+		outregvar();
+}
+
+outregvar() {
+	register i,j;
+
+	fprintf(hfile,"#define REGVARS\n");
+	fprintf(cfile,"#include \"regvar.h\"\n");
+	fprintf(cfile,"int nregvar[4] = { ");
+	for (i=0;i<4;i++) fprintf(cfile,"%d, ",nregvar[i]);
+	fprintf(cfile,"};\n");
+	for (i=0;i<4;i++)
+		if (nregvar[i]>0)
+			fprintf(cfile,"struct regassigned ratar%d[%d];\n",
+					i,nregvar[i]);
+	for (i=0;i<4;i++) if (nregvar[i]>0) {
+		fprintf(cfile,"int rvtar%d[] = {",i);
+		for (j=0;j<nregvar[i];j++)
+			fprintf(cfile,"%d,",rvnumbers[i][j]);
+		fprintf(cfile,"};\n");
+	}
+	fprintf(cfile,"\nint *rvnumbers[] = {\n");
+	for (i=0;i<4;i++)
+		if (nregvar[i]>0)
+			fprintf(cfile,"\trvtar%d,\n",i);
+		else
+			fprintf(cfile,"\t0,\n");
+	fprintf(cfile,"};\n\nstruct regassigned *regassigned[] = {\n");
+	for (i=0;i<4;i++)
+		if (nregvar[i]>0)
+			fprintf(cfile,"\tratar%d,\n",i);
+		else
+			fprintf(cfile,"\t0,\n");
+	fprintf(cfile,"};\n");
+}
+
+verbose() {
+
+	fprintf(stderr,"Codebytes %d\n",codebytes);
+	fprintf(stderr,"Registers %d(%d)\n",nmachregs,MAXREGS);
+	fprintf(stderr,"Properties %d(%d)\n",nprops,MAXPROPS);
+	fprintf(stderr,"Tokens %d(%d)\n",nmachtokens,MAXTOKENS);
+	fprintf(stderr,"Sets %d(%d)\n",nmachsets,MAXSETS);
+	fprintf(stderr,"Tokeninstances %d(%d)\n",narinstance,MAXINSTANCE);
+	fprintf(stderr,"Strings %d(%d)\n",ncodestrings,MAXSTRINGS);
+	fprintf(stderr,"Enodes %d(%d)\n",lastnode-nodes,MAXNODES);
+	fprintf(stderr,"Patbytes %d(%d)\n",npatbytes,MAXPATTERN);
+}
+
+inbetween() {
+	register ident_p ip;
+	register i,j;
+	register move_p mp;
+
+	lookident=1;    /* for lexical analysis */
+
+	chktabsiz(nmachsets+1,MAXSETS,"Expressiontable");
+	for (i=0;i<SETSIZE;i++)
+		machsets[nmachsets].set_val[i] = 0xFFFF;
+	machsets[nmachsets].set_val[0] &= ~1;
+	machsets[nmachsets].set_size = 0;
+	ip=ilookup("SCRATCH",ENTER);
+	ip->i_type=IEXP;
+	ip->i_i.i_expno = nmachsets++;
+
+	for (i=0;i<SETSIZE;i++)
+		machsets[nmachsets].set_val[i] = 0xFFFF;
+	machsets[nmachsets].set_size = 0;
+	ip=ilookup("ALL",ENTER);
+	ip->i_type=IEXP;
+	allexpno = ip->i_i.i_expno = nmachsets++;
+	mp = &machmoves[nmoves++];
+	mp->m_set1 = cocosetno;
+	mp->m_expr1 = 0;
+	mp->m_set2 = nmachsets-1;
+	mp->m_expr2 = 0;
+	mp->m_cindex = 0;
+	mp->m_cost.c_size = 0;
+	mp->m_cost.c_time = 0;
+
+	/*
+	 * Create sets of registers per property
+	 */
+
+	for (i=0;i<nprops;i++) {
+		short *sp = machprops[i].propset.set_val;
+
+		sp[0] |= 1;
+		for (j=2;j<=nmachregs;j++)
+			if (machregs[j-1]->rprop[i>>4]&(1<<(i&017)))
+				sp[j>>4] |= (1<<(j&017));
+	}
+}
+
+formconversion(p,tp) register char *p; register token_p tp; {
+	char buf[256];
+	register char *q=buf;
+	char field[256];
+	register char *f;
+	int i;
+
+	if (p==0)
+		return(0);
+	while (*p) switch(*p) {
+	default: *q++ = *p++; continue;
+	case '%':
+		p++;
+		if(*p == '%') {
+			*q++ = *p++;
+			continue;
+		}
+		if (*p == '[')
+			p++;
+		else
+			yyerror("Bad character after % in format");
+		f=field;
+		while (*p != 0 && *p != ']')
+			*f++ = *p++;
+		*f++ = 0;
+		if (*p == ']')
+			p++;
+		else
+			yyerror("Unterminated %[] construct in format");
+		for (i=0;i<TOKENSIZE-1;i++)
+			if (strcmp(field,tp->t_fields[i].t_sname)==0)
+				break;
+		if (i==TOKENSIZE-1)
+			yyerror("Unknown field in %[] construct in format");
+		*q++ = i+1;
+	}
+	*q++ = 0;
+	return(strlookup(buf));
+}
+
+setfields(tp,format) register token_p tp; string format; {
+	register i;
+	list2 ll;
+	register list1 l;
+	int type;
+
+	for(i=0;i<TOKENSIZE-1;i++)
+		tp->t_fields[i].t_type = 0;
+	i=0;
+	for(ll=tp->t_struct;ll!=0;ll=ll->l2next) {
+		l=ll->l2list;
+		if(strcmp(l->l1name,"REGISTER")==0)
+			type = TYPREG;
+		else if (strcmp(l->l1name,"INT")==0)
+			type = TYPINT;
+		else    type = TYPSTR;
+		for(l=l->l1next;l!=0;l=l->l1next) {
+			tp->t_fields[i].t_type = type;
+			tp->t_fields[i].t_sname = l->l1name;
+			i++;
+		}
+	}
+	if (format != 0)
+		tp->t_format = formconversion(format,tp);
+	else
+		tp->t_format = -1;
+}
+
+chkregexp(number) {
+	register i;
+
+	for(i=nmachregs+1;i<nmachregs+1+nmachtokens;i++)
+		if(machsets[number].set_val[i>>4]&(01<<(i&017)))
+			yyerror("No tokens allowed in this set");
+}
+
+findstructel(number,name,t) string name; int *t; {
+	register i;
+	register token_p tp;
+	register list2 structdecl;
+	int offset;
+
+	for(i=1;i<=nmachregs;i++)
+		if (machsets[number].set_val[i>>4]&(01<<(i&017)))
+			yyerror("No registers allowed in this set");
+	structdecl = 0;
+	for (i=nmachregs+1;i<nmachregs+1+nmachtokens;i++) {
+		if (machsets[number].set_val[i>>4]&(01<<(i&017))) {
+			if (structdecl == 0) {
+				structdecl = machtokens[i-(nmachregs+1)].t_struct;
+				tp = &machtokens[i-(nmachregs+1)];
+			} else if(structdecl != machtokens[i-(nmachregs+1)].t_struct)
+					yyerror("Multiple structs in this set");
+		}
+	}
+	if (structdecl == 0) {
+		yyerror("No structs in this set");
+		return(0);
+	}
+	for(offset=0;offset<TOKENSIZE-1;offset++)
+		if(tp->t_fields[offset].t_type != 0 &&
+		   strcmp(tp->t_fields[offset].t_sname,name)==0) {
+			*t = tp->t_fields[offset].t_type;
+			return(offset+1);
+		}
+	yyerror("No such field in this struct");
+	return(0);
+}
+
+extern char em_flag[];
+
+argtyp(mn) {
+
+	switch(em_flag[mn-sp_fmnem]&EM_PAR) {
+	case PAR_W:
+	case PAR_S:
+	case PAR_Z:
+	case PAR_O:
+	case PAR_N:
+	case PAR_L:
+	case PAR_F:
+	case PAR_R:
+	case PAR_C:
+		return(TYPINT);
+	default:
+		return(TYPSTR);
+	}
+}
+
+commontype(e1,e2) expr_t e1,e2; {
+
+	if(e1.expr_typ != e2.expr_typ)
+		yyerror("Type incompatibility");
+	return(e1.expr_typ);
+}
+
+extern char em_mnem[][4];
+
+#define HASHSIZE        (2*(sp_lmnem-sp_fmnem))
+
+struct hashmnem {
+	char h_name[3];
+	byte h_value;
+} hashmnem[HASHSIZE];
+
+inithash() {
+	register i;
+
+	for(i=0;i<=sp_lmnem-sp_fmnem;i++)
+		enter(em_mnem[i],i+sp_fmnem);
+}
+
+enter(name,value) char *name; {
+	register unsigned h;
+
+	h=hash(name)%HASHSIZE;
+	while (hashmnem[h].h_name[0] != 0)
+		h = (h+1)%HASHSIZE;
+	strncpy(hashmnem[h].h_name,name,3);
+	hashmnem[h].h_value = value;
+}
+
+int mlookup(name) char *name; {
+	register unsigned h;
+
+	h = hash(name)%HASHSIZE;
+	while (strncmp(hashmnem[h].h_name,name,3) != 0 &&
+	       hashmnem[h].h_name[0] != 0)
+		h = (h+1)%HASHSIZE;
+	return(hashmnem[h].h_value&BMASK);      /* 0 if not found */
+}
+
+hashpatterns() {
+	short index;
+	register byte *bp,*tp;
+	register short i;
+	unsigned short hashvalue;
+	int patlen;
+
+	index = prevind;
+	while (index != 0) {
+		bp = &pattern[index];
+		tp = &bp[PO_MATCH];
+		i = *tp++&BMASK;
+		if (i==BMASK) {
+			i = *tp++&BMASK;
+			i |= (*tp++&BMASK)<<BSHIFT;
+		}
+		patlen = i;
+		hashvalue = 0;
+		switch(patlen) {
+		default:        /* 3 or more */
+			hashvalue = (hashvalue<<4)^(*tp++&BMASK);
+		case 2:
+			hashvalue = (hashvalue<<4)^(*tp++&BMASK);
+		case 1:
+			hashvalue = (hashvalue<<4)^(*tp++&BMASK);
+		}
+		assert(hashvalue!= ILLHASH);
+		i=index;
+		index = (bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<BSHIFT);
+		bp[PO_HASH] = hashvalue>>BSHIFT;
+		hashvalue &= BMASK;
+		bp[PO_NEXT] = pathash[hashvalue]&BMASK;
+		bp[PO_NEXT+1] = pathash[hashvalue]>>BSHIFT;
+		pathash[hashvalue] = i;
+	}
+}
+
+debug() {
+	register i,j;
+
+	for(i=0;i<ITABSIZE;i++) {
+		register ident_p ip;
+		for(ip=identtab[i];ip!=0;ip=ip->i_next)
+			printf("%-14s %1d %3d\n",ip->i_name,
+				ip->i_type,ip->i_i.i_regno);
+	}
+
+	for(i=2;i<nmachregs;i++) {
+		register reginfo rp;
+
+		rp=machregs[i];
+		printf("%s = (\"%s\", %d",rp->rname,rp->rrepr,rp->rsize);
+		for(j=0;j<MAXMEMBERS;j++)
+			if(rp->rmembers[j] != 0)
+				printf(", %s",machregs[rp->rmembers[j]]->rname);
+		printf(")");
+		for(j=0;j<nprops;j++)
+			if(rp->rprop[j>>4]&(1<<(j&017)))
+				printf(", %s",machprops[j].propname->i_name);
+		printf(".\n");
+	}
+}
+
+out(n) {
+
+	assert(n>=0);
+	if (n<128)
+		outbyte(n);
+	else {
+		outbyte(n/256+128);
+		outbyte(n%256);
+	}
+}
+
+outbyte(n) {
+
+	fprintf(cfile,"%d, ",n&BMASK);
+	codebytes++;
+}
+
+pat(n) {
+
+	assert(n>=0);
+	if (n<128)
+		patbyte(n);
+	else {
+		patbyte(n/256+128);
+		patbyte(n%256);
+	}
+}
+
+patshort(n) {
+
+	patbyte(n&BMASK);
+	patbyte(n>>BSHIFT);
+}
+
+patbyte(n) {
+
+	chktabsiz(npatbytes,MAXPATTERN,"Pattern table");
+	pattern[npatbytes++] = n;
+}
+
+max(a,b) {
+
+	if (a>b)
+		return(a);
+	return(b);
+}
+
+#include "bootlex.c"

+ 189 - 0
util/cgg/bootlex.l

@@ -0,0 +1,189 @@
+%{
+
+#ifndef NORCSID
+static char rcsid2[]="$Header$";
+#endif
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#undef input
+#undef output
+#undef unput
+
+#define MAXBACKUP 50
+%}
+%%
+"/*"                    { char c;
+                          c = input();
+                          do {
+                                while (c!='*')
+                                        c = input();
+                                c = input();
+                          } while (c!='/');
+                        }
+"REGISTERS:"            return(REGISTERHEAD);
+"TOKENS:"               return(TOKENHEAD);
+"TOKENEXPRESSIONS:"     return(EXPRESSIONHEAD);
+"CODE:"                 return(CODEHEAD);
+"MOVES:"                return(MOVEHEAD);
+"TESTS:"                return(TESTHEAD);
+"STACKS:"		return(STACKHEAD);
+"SIZEFACTOR"		return(SIZEFAC);
+"TIMEFACTOR"		return(TIMEFAC);
+"FORMAT"		return(FORMAT);
+
+"cost"                  return(COST);
+"remove"                return(REMOVE);
+"|"                     return(SEP);
+"samesign"              return(SAMESIGN);
+"inreg"			return(INREG);
+"sfit"                  return(SFIT);
+"ufit"                  return(UFIT);
+"defined"               return(DEFINED);
+"rom"                   return(ROM);
+"loww"			return(LOWW);
+"highw"			return(HIGHW);
+"move"                  return(MOVE);
+"erase"                 return(ERASE);
+"allocate"              return(ALLOCATE);
+"tostring"              return(TOSTRING);
+"nocc"                  return(NOCC);
+"setcc"                 return(SETCC);
+"samecc"                return(SAMECC);
+"test"                  return(TEST);
+"STACK"                 return(STACK);
+"nocoercions"		return(NOCOERC);
+
+"&&"                    return(AND2);
+"||"                    return(OR2);
+"=="                    return(CMPEQ);
+"!="                    return(CMPNE);
+"<="                    return(CMPLE);
+"<"                     return(CMPLT);
+">"                     return(CMPGT);
+">="                    return(CMPGE);
+">>"                    return(RSHIFT);
+"<<"                    return(LSHIFT);
+"!"                     return(NOT);
+"~"                     return(COMP);
+"..."                   return(ELLIPS);
+
+EM_WSIZE                { yylval.yy_intp = &wsize; return(CIDENT); }
+EM_PSIZE                { yylval.yy_intp = &psize; return(CIDENT); }
+EM_BSIZE                { yylval.yy_intp = &bsize; return(CIDENT); }
+REGISTER                { yylval.yy_string = "REGISTER"; return(TYPENAME); }
+INT                     { yylval.yy_string = "INT"; return(TYPENAME); }
+STRING                  { yylval.yy_string = "STRING"; return(TYPENAME); }
+
+regvar			return(REGVAR);
+loop			return(LOOP);
+pointer			return(POINTER);
+float			return(FLOAT);
+return			return(RETURN);
+
+[_A-Za-z][_A-Za-z0-9]+  {register ident_p ip;
+                         if(!lookident || (ip=ilookup(yytext,JUSTLOOKING))==0) {
+                           yylval.yy_string = scopy(yytext);return(IDENT);
+                         } else {
+                           yylval.yy_ident = ip;
+                           switch(ip->i_type) {
+                           default:assert(0);
+                           case IREG:return(RIDENT);
+                           case IPRP:return(PIDENT);
+                           case ITOK:return(TIDENT);
+                           case IEXP:return(EIDENT);
+                           }
+                         }
+                        }
+[a-z]                   {yylval.yy_char = yytext[0]; return(LCASELETTER);}
+[0-9]*                  {yylval.yy_int = atoi(yytext);return(NUMBER);}
+(\"|"%)")               { char *p; int c,tipe;
+                          p=yytext;
+                          for (;;) {
+                                c = input();
+                                switch(c) {
+                                default: *p++=c;break;
+                                case '\\':
+                                        *p++=c; *p++=input(); break;
+                                case '\n':
+                                        yyerror("Unterminated string");
+                                        break;
+                                case '"':
+                                        tipe=STRING; goto endstr;
+                                case '%':
+                                        c=input();
+                                        if (c == '(') {
+                                                tipe=LSTRING;goto endstr;
+                                        } else {
+                                                *p++ = '%'; unput(c); break;
+                                        }
+                                }
+                          }
+                        endstr:
+                          *p++ = 0;
+                          yylval.yy_string = scopy(yytext);
+                          return(tipe);
+                        }
+[ \t]*                  |
+\n                      ;
+.                       return(yytext[0]);
+%%
+
+char linebuf[256];
+char prevbuf[256];
+int linep;
+int linepos;    /* corrected for tabs */
+char charstack[MAXBACKUP];
+int nbackup=0;
+
+output(c) {
+
+        assert(0);
+}
+
+input() {
+
+        if(nbackup)
+                return(charstack[--nbackup]);
+        if(linebuf[linep]==0) {
+                strcpy(prevbuf,linebuf);
+                if(fgets(linebuf,256,stdin)==NULL)
+                        return(0);
+                lino++;
+                linepos=linep=0;
+        }
+        if (linebuf[linep] == '\t')
+                linepos = (linepos+8) & ~07;
+        else    linepos++;
+        return(linebuf[linep++]);
+}
+
+unput(c) {
+
+        chktabsiz(nbackup,MAXBACKUP,"Lexical backup table");
+        charstack[nbackup++] = c;
+}
+
+yyerror(s,a1,a2,a3,a4) string s; {
+
+        fprintf(stderr,"%d\t%s%d\t%s\t%*c   ",lino-1,prevbuf,lino,linebuf,
+                linepos-1,'^');
+	fprintf(stderr,s,a1,a2,a3,a4);
+	fprintf(stderr,"\n");
+        nerrors++;
+}

+ 202 - 0
util/opt/Makefile

@@ -0,0 +1,202 @@
+# $Header$
+
+CFILES=main.c getline.c lookup.c var.c process.c backward.c util.c\
+	alloc.c putline.c cleanup.c peephole.c flow.c reg.c
+OFILES=main.o getline.o lookup.o var.o process.o backward.o util.o\
+	alloc.o putline.o cleanup.o peephole.o flow.o reg.o
+KFILES=main.k getline.k lookup.k var.k process.k backward.k util.k\
+	alloc.k putline.k cleanup.k peephole.k flow.k reg.k
+LIBS=../../lib/em_data.a
+CFLAGS=-O -DNDEBUG
+LDFLAGS=-i
+LINT=lint
+OPR=wide|opr
+XREF=xref -c -w80
+PROPTS=
+# LEXLIB is implementation dependent, try -ll or -lln first
+LEXLIB=-ll
+
+.DEFAULT:
+	co -q $<
+
+opt:    $(OFILES) pattern.o $(LIBS)
+	cc $(LDFLAGS) $(CFLAGS) $(OFILES) pattern.o $(LIBS) -o opt
+
+test:   opt testopt
+	testopt
+
+cmp :   opt
+	cmp opt ../../lib/em_opt
+
+install:opt
+	size opt ../../lib/em_opt
+	cp opt ../../lib/em_opt
+
+pattern.c:      patterns mktab
+	/lib/cpp patterns | mktab > pattern.c
+
+mktab:  mktab.o $(LIBS)
+	cc $(CFLAGS) mktab.o $(LIBS) $(LEXLIB) -o mktab
+
+depend: makedepend
+	makedepend
+
+lint:   $(CFILES) pattern.c
+	$(LINT) $(CFILES) pattern.c>lint 2>&1
+
+printall:
+	-pr $(PROPTS) Makefile -n *.h `ls $(CFILES)` mktab.y scan.l patterns|$(OPR)
+	touch print
+
+print:  Makefile *.h $(CFILES) mktab.y scan.l patterns
+	-pr $(PROPTS) -n $? | $(OPR)
+
+opr:
+	make pr ^ $(OPR)
+
+pr:
+	@pr $(PROPTS) -n Makefile *.h $(CFILES) mktab.y scan.l patterns
+
+xref:
+	$(XREF) *.h $(CFILES) | pr $(PROPTS) -h "XREF EMOPT"|$(OPR)&
+
+sizes:  opt
+	-nm opt | sort -n| /usr/plain/bin/map
+
+clean:
+	rm -f *.o opt mktab mktab.c scan.c pattern.c
+
+kfiles: $(KFILES)
+
+.SUFFIXES: .k
+.c.k: ; cem -c $*.c
+
+# the next lines are generated automatically
+# AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
+alloc.o:	alloc.h
+alloc.o:	assert.h
+alloc.o:	line.h
+alloc.o:	lookup.h
+alloc.o:	param.h
+alloc.o:	proinf.h
+alloc.o:	types.h
+backward.o:	../../h/em_mnem.h
+backward.o:	../../h/em_pseu.h
+backward.o:	../../h/em_spec.h
+backward.o:	alloc.h
+backward.o:	assert.h
+backward.o:	ext.h
+backward.o:	line.h
+backward.o:	lookup.h
+backward.o:	param.h
+backward.o:	proinf.h
+backward.o:	types.h
+cleanup.o:	../../h/em_mes.h
+cleanup.o:	../../h/em_pseu.h
+cleanup.o:	../../h/em_spec.h
+cleanup.o:	assert.h
+cleanup.o:	ext.h
+cleanup.o:	lookup.h
+cleanup.o:	param.h
+cleanup.o:	types.h
+flow.o:	../../h/em_flag.h
+flow.o:	../../h/em_mnem.h
+flow.o:	../../h/em_spec.h
+flow.o:	alloc.h
+flow.o:	ext.h
+flow.o:	line.h
+flow.o:	optim.h
+flow.o:	param.h
+flow.o:	proinf.h
+flow.o:	types.h
+getline.o:	../../h/em_flag.h
+getline.o:	../../h/em_mes.h
+getline.o:	../../h/em_pseu.h
+getline.o:	../../h/em_spec.h
+getline.o:	alloc.h
+getline.o:	assert.h
+getline.o:	ext.h
+getline.o:	line.h
+getline.o:	lookup.h
+getline.o:	param.h
+getline.o:	proinf.h
+getline.o:	types.h
+lookup.o:	alloc.h
+lookup.o:	lookup.h
+lookup.o:	param.h
+lookup.o:	proinf.h
+lookup.o:	types.h
+main.o:	../../h/em_spec.h
+main.o:	alloc.h
+main.o:	ext.h
+main.o:	param.h
+main.o:	types.h
+mktab.o:	../../h/em_mnem.h
+mktab.o:	../../h/em_spec.h
+mktab.o:	optim.h
+mktab.o:	param.h
+mktab.o:	pattern.h
+mktab.o:	scan.c
+mktab.o:	types.h
+pattern.o:	param.h
+pattern.o:	pattern.h
+pattern.o:	types.h
+peephole.o:	../../h/em_mnem.h
+peephole.o:	../../h/em_spec.h
+peephole.o:	alloc.h
+peephole.o:	assert.h
+peephole.o:	ext.h
+peephole.o:	line.h
+peephole.o:	lookup.h
+peephole.o:	optim.h
+peephole.o:	param.h
+peephole.o:	pattern.h
+peephole.o:	proinf.h
+peephole.o:	types.h
+process.o:	../../h/em_pseu.h
+process.o:	../../h/em_spec.h
+process.o:	alloc.h
+process.o:	assert.h
+process.o:	ext.h
+process.o:	line.h
+process.o:	lookup.h
+process.o:	param.h
+process.o:	proinf.h
+process.o:	types.h
+putline.o:	../../h/em_flag.h
+putline.o:	../../h/em_mnem.h
+putline.o:	../../h/em_pseu.h
+putline.o:	../../h/em_spec.h
+putline.o:	alloc.h
+putline.o:	assert.h
+putline.o:	ext.h
+putline.o:	line.h
+putline.o:	lookup.h
+putline.o:	optim.h
+putline.o:	param.h
+putline.o:	proinf.h
+putline.o:	types.h
+reg.o:	../../h/em_mes.h
+reg.o:	../../h/em_pseu.h
+reg.o:	../../h/em_spec.h
+reg.o:	alloc.h
+reg.o:	assert.h
+reg.o:	ext.h
+reg.o:	line.h
+reg.o:	param.h
+reg.o:	proinf.h
+reg.o:	types.h
+scan.o:	stdio.h
+special.o:	param.h
+special.o:	types.h
+util.o:	assert.h
+util.o:	ext.h
+util.o:	lookup.h
+util.o:	optim.h
+util.o:	param.h
+util.o:	proinf.h
+util.o:	types.h
+var.o:	lookup.h
+var.o:	param.h
+var.o:	proinf.h
+var.o:	types.h

+ 448 - 0
util/opt/alloc.c

@@ -0,0 +1,448 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include <stdio.h>
+#include "param.h"
+#include "types.h"
+#include "assert.h"
+#include "alloc.h"
+#include "line.h"
+#include "lookup.h"
+#include "proinf.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#ifdef USEMALLOC
+
+short * myalloc();
+
+#define newcore(size) myalloc(size)
+#define oldcore(p,size) free(p)
+
+#else
+
+/* #define CORECHECK	/* if defined tests are made to insure
+			   each block occurs at most once */
+
+#define CCHUNK	1024	/* number of shorts asked from system */
+
+short *newcore(),*freshcore();
+extern char *sbrk();
+
+#ifdef COREDEBUG
+int shortsasked=0;
+#endif
+
+#endif
+
+/*
+ * The following two sizetables contain the sizes of the various kinds
+ * of line and argument structures.
+ * Care has been taken to make this table implementation independent,
+ * but if you think very hard you might find a compiler failing the
+ * assumptions made.
+ * A wasteful but safe approach is to replace every line of them by
+ *  sizeof(line_t)
+ * and
+ *  sizeof(arg_t)
+ * respectively.
+ */
+
+#define LBASE (sizeof(line_t)-sizeof(un_l_a))
+
+int lsizetab[] = {
+	LBASE,
+	LBASE+sizeof(short),
+	LBASE+sizeof(offset),
+	LBASE+sizeof(num_p),
+	LBASE+sizeof(sym_p),
+	LBASE+sizeof(s_la_sval),
+	LBASE+sizeof(s_la_lval),
+	LBASE+sizeof(arg_p),
+	LBASE
+};
+
+#define ABASE (sizeof(arg_t)-sizeof(un_a_a))
+
+int asizetab[] = {
+	ABASE+sizeof(offset),
+	ABASE+sizeof(num_p),
+	ABASE+sizeof(sym_p),
+	ABASE+sizeof(s_a_val),
+	ABASE+sizeof(argb_t),
+	ABASE+sizeof(s_a_con),
+	ABASE+sizeof(s_a_con),
+	ABASE+sizeof(s_a_con),
+};
+
+/*
+ * alloc routines:
+ * Two parts:
+ *   1)	typed alloc and free routines
+ *   2) untyped raw core allocation
+ */
+
+/*
+ * PART 1
+ */
+
+line_p	newline(optyp) int optyp; {
+	register line_p lnp;
+	register kind=optyp;
+
+	if (kind>OPMINI)
+		kind = OPMINI;
+	lnp = (line_p) newcore(lsizetab[kind]);
+	lnp->l_optyp = optyp;
+	return(lnp);
+}
+
+oldline(lnp) register line_p lnp; {
+	register kind=lnp->l_optyp&BMASK;
+
+	if (kind>OPMINI)
+		kind = OPMINI;
+	if (kind == OPLIST)
+		oldargs(lnp->l_a.la_arg);
+	oldcore((short *) lnp,lsizetab[kind]);
+}
+
+arg_p newarg(kind) int kind; {
+	register arg_p ap;
+
+	ap = (arg_p) newcore(asizetab[kind]);
+	ap->a_typ = kind;
+	return(ap);
+}
+
+oldargs(ap) register arg_p ap; {
+	register arg_p	next;
+
+	while (ap != (arg_p) 0) {
+		next = ap->a_next;
+		switch(ap->a_typ) {
+		case ARGSTR:
+			oldargb(ap->a_a.a_string.ab_next);
+			break;
+		case ARGICN:
+		case ARGUCN:
+		case ARGFCN:
+			oldargb(ap->a_a.a_con.ac_con.ab_next);
+			break;
+		}
+		oldcore((short *) ap,asizetab[ap->a_typ]);
+		ap = next;
+	}
+}
+
+oldargb(abp) register argb_p abp; {
+	register argb_p next;
+
+	while (abp != (argb_p) 0) {
+		next = abp->ab_next;
+		oldcore((short *) abp,sizeof (argb_t));
+		abp = next;
+	}
+}
+
+reg_p newreg() {
+
+	return((reg_p) newcore(sizeof(reg_t)));
+}
+
+oldreg(rp) reg_p rp; {
+
+	oldcore((short *) rp,sizeof(reg_t));
+}
+
+num_p newnum() {
+
+	return((num_p) newcore(sizeof(num_t)));
+}
+
+oldnum(lp) num_p lp; {
+
+	oldcore((short *) lp,sizeof(num_t));
+}
+
+offset *newrom() {
+
+	return((offset *) newcore(MAXROM*sizeof(offset)));
+}
+
+sym_p newsym(len) int len; {
+	/*
+	 * sym_t includes a 2 character s_name at the end
+	 * extend this structure with len-2 characters
+	 */
+	return((sym_p) newcore(sizeof(sym_t) - 2 + len));
+}
+
+argb_p newargb() {
+
+	return((argb_p) newcore(sizeof(argb_t)));
+}
+
+#ifndef USEMALLOC
+
+/******************************************************************/
+/******   Start of raw core management package    *****************/
+/******************************************************************/
+
+#define MAXSHORT 30	/* Maximum number of shorts one can ask for */
+
+short *freelist[MAXSHORT];
+
+typedef struct coreblock {
+	struct coreblock *co_next;
+	short co_size;
+} core_t,*core_p;
+
+#define SINC	(sizeof(core_t)/sizeof(short))
+#ifdef COREDEBUG
+coreverbose() {
+	register size;
+	register short *p;
+	register sum;
+
+	sum = 0;
+	for(size=1;size<MAXSHORT;size++)
+		for (p=freelist[size];p!=0;p = *(short **) p)
+			sum += size;
+	fprintf(stderr,"Used core %u\n",(shortsasked-sum)*sizeof(short));
+}
+#endif
+
+#ifdef SEPID
+
+compactcore() {
+	register core_p corelist=0,tp,cl;
+	int size;
+
+#ifdef COREDEBUG
+	fprintf(stderr,"Almost out of core\n");
+#endif
+	for(size=SINC;size<MAXSHORT;size++) {
+		while ((tp = (core_p) freelist[size]) != (core_p) 0) {
+			freelist[size] = (short *) tp->co_next;
+			tp->co_size = size;
+			if (corelist==0 || tp<corelist) {
+				tp->co_next = corelist;
+				corelist = tp;
+			} else {
+				for(cl=corelist;cl->co_next != 0 && tp>cl->co_next;
+							cl = cl->co_next)
+					;
+				tp->co_next = cl->co_next;
+				cl->co_next = tp;
+			}
+		}
+	}
+	while (corelist != 0) {
+		while ((short *) corelist->co_next ==
+		    (short *) corelist + corelist->co_size) {
+			corelist->co_size += corelist->co_next->co_size;
+			corelist->co_next =  corelist->co_next->co_next;
+		}
+		assert(corelist->co_next==0 ||
+			(short *) corelist->co_next >
+			    (short *) corelist + corelist->co_size);
+		while (corelist->co_size >= MAXSHORT+SINC) {
+			oldcore((short *) corelist + corelist->co_size-(MAXSHORT-1),
+				sizeof(short)*(MAXSHORT-1));
+			corelist->co_size -= MAXSHORT;
+		}
+		if (corelist->co_size >= MAXSHORT) {
+			oldcore((short *) corelist + corelist->co_size-SINC,
+				sizeof(short)*SINC);
+			corelist->co_size -= SINC;
+		}
+		cl = corelist->co_next;
+		oldcore((short *) corelist, sizeof(short)*corelist->co_size);
+		corelist = cl;
+	}
+}
+
+short *grabcore(size) int size; {
+	register short *p;
+	register trysize;
+
+	/*
+	 * Desperate situation, can't get more core from system.
+	 * Postpone giving up just a little bit by splitting up
+	 * larger free blocks if possible.
+	 * Algorithm is worst fit.
+	 */
+
+	assert(size<2*MAXSHORT);
+	for(trysize=2*MAXSHORT-2; trysize>size; trysize -= 2) {
+		p = freelist[trysize/sizeof(short)];
+		if ( p != (short *) 0) {
+			freelist[trysize/sizeof(short)] = *(short **) p;
+			oldcore(p+size/sizeof(short),trysize-size);
+			return(p);
+		}
+	}
+
+	/*
+	 * Can't get more core from the biggies, try to combine the
+	 * little ones. This is expensive but probably better than
+	 * giving up.
+	 */
+
+	compactcore();
+	if ((p=freelist[size/sizeof(short)]) != 0) {
+		freelist[size/sizeof(short)] = * (short **) p;
+		return(p);
+	}
+	for(trysize=2*MAXSHORT-2; trysize>size; trysize -= 2) {
+		p = freelist[trysize/sizeof(short)];
+		if ( p != (short *) 0) {
+			freelist[trysize/sizeof(short)] = *(short **) p;
+			oldcore(p+size/sizeof(short),trysize-size);
+			return(p);
+		}
+	}
+
+	/*
+	 * That's it then. Finished.
+	 */
+
+	return(0);
+}
+#endif	/* SEPID */
+
+short *newcore(size) int size; {
+	register short *p,*q;
+
+	if( size < 2*MAXSHORT ) {
+		if ((p=freelist[size/sizeof(short)]) != (short *) 0)
+			freelist[size/sizeof(short)] = *(short **) p;
+		else {
+			p = freshcore(size);
+#ifdef SEPID
+			if (p == (short *) 0)
+				p = grabcore(size);
+#endif
+		}
+	} else
+		p = freshcore(size);
+	if (p == 0)
+		error("out of memory");
+	for (q=p; size > 0 ; size -= sizeof(short))
+		*q++ = 0;
+	return(p);
+}
+
+#ifdef NOMALLOC
+
+/*
+ * stdio uses malloc and free.
+ * you can use these as substitutes
+ */
+
+char *malloc(size) int size; {
+
+	/*
+	 * malloc(III) is called by stdio,
+	 * this routine is a substitute.
+	 */
+
+	return( (char *) newcore(size));
+}
+
+free() {
+
+}
+#endif
+
+oldcore(p,size) short *p; int size; {
+#ifdef CORECHECK
+	register short *cp;
+#endif
+
+	assert(size<2*MAXSHORT);
+#ifdef CORECHECK
+	for (cp=freelist[size/sizeof(short)]; cp != (short *) 0;
+	    cp = (short *) *cp)
+		assert(cp != p);
+#endif
+	*(short **) p = freelist[size/sizeof(short)];
+	freelist[size/sizeof(short)] = p;
+}
+
+short *ccur,*cend;
+
+coreinit(p1,p2) short *p1,*p2; {
+
+	/*
+	 * coreinit is called with the boundaries of a piece of
+	 * memory that can be used for starters.
+	 */
+
+	ccur = p1;
+	cend = p2;
+}
+
+short *freshcore(size) int size; {
+	register short *temp;
+	static int cchunk=CCHUNK;
+	
+	while(&ccur[size/sizeof(short)] >= cend && cchunk>0) {
+		do {
+			temp = (short *) sbrk(cchunk*sizeof(short));
+			if (temp == (short *) -1)
+				cchunk >>= 1;
+			else if (temp != cend)
+				ccur = cend = temp;
+		} while (temp == (short *) -1 && cchunk>0);
+		cend += cchunk;
+#ifdef COREDEBUG
+		shortsasked += cchunk;
+#endif
+	}
+	if (cchunk==0)
+		return(0);
+	temp = ccur;
+	ccur = &ccur[size/sizeof(short)];
+	return(temp);
+}
+
+#else	/* USEMALLOC */
+
+coreinit() {
+
+	/*
+	 * Empty function, no initialization needed
+	 */
+}
+
+short *myalloc(size) register size; {
+	register short *p,*q;
+	extern char *malloc();
+
+	p = (short *)malloc(size);
+	if (p == 0)
+		error("out of memory");
+	for(q=p;size>0;size -= sizeof(short))
+		*q++ = 0;
+	return(p);
+}
+#endif

+ 55 - 0
util/opt/alloc.h

@@ -0,0 +1,55 @@
+/* $Header$ */
+
+extern line_p 	newline();
+extern offset	*newrom();
+extern sym_p	newsym();
+extern num_p	newnum();
+extern arg_p	newarg();
+extern argb_p	newargb();
+extern reg_p	newreg();
+
+extern		oldline();
+extern		oldloc();
+extern		oldreg();
+
+/* #define USEMALLOC	/* if defined malloc() and free() are used */
+
+/* #define COREDEBUG	/* keep records and print statistics */
+
+/*
+ * The next define gives if defined the number of pseudo's outside
+ * procedures that are collected without processing.
+ * If undefined all pseudo's will be collected but that may
+ * give trouble on small machines, because of lack of room.
+ */
+#define PSEUBETWEEN 200 
+
+#ifndef USEMALLOC
+/*
+ * Now the real bitsqueezing starts.
+ * When running on a machine where code and data live in
+ * separate address-spaces it is worth putting in some extra
+ * code to save on probably less data.
+ */
+#define SEPID		/* code and data in separate spaces */
+/*
+ * If the stack segment and the data are separate as on a PDP11 under UNIX
+ * it is worth squeezing some shorts out of the stack page.
+ */
+#ifndef EM_WSIZE
+/*
+ * Compiled with 'standard' C compiler
+ */
+#define STACKROOM 3200	/* number of shorts space in stack */
+#else
+/*
+ * Compiled with pcc, has trouble with lots of variables
+ */
+#define STACKROOM 2000
+#endif
+
+#else
+
+#define STACKROOM 1	/* 0 gives problems */
+
+#endif	/* USEMALLOC */

+ 7 - 0
util/opt/assert.h

@@ -0,0 +1,7 @@
+/* $Header$ */
+
+#ifndef NDEBUG
+#define assert(x) if(!(x)) badassertion(__FILE__,__LINE__)
+#else
+#define assert(x)	/* nothing */
+#endif

+ 187 - 0
util/opt/backward.c

@@ -0,0 +1,187 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "param.h"
+#include "types.h"
+#include "assert.h"
+#include "line.h"
+#include "lookup.h"
+#include "alloc.h"
+#include "proinf.h"
+#include "../../h/em_spec.h"
+#include "../../h/em_pseu.h"
+#include "../../h/em_mnem.h"
+#include "ext.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#define local(x)	if (((x)->s_flags&SYMKNOWN) == 0)\
+				x->s_flags &= ~ SYMGLOBAL
+#define global(x)	if(((x)->s_flags&SYMKNOWN) == 0)\
+				x->s_flags |= SYMGLOBAL
+
+#define DTYPHOL	1
+#define DTYPBSS 2
+#define DTYPCON 3
+#define DTYPROM 4
+byte	curdtyp;
+bool	goodrom;
+short	curfrag = 3;	/* see also peephole.c */
+offset rombuf[MAXROM];
+int	rc;
+
+backward() {
+	register line_p lnp;
+	line_p	next;
+	register arg_p ap;
+	line_p i,p;
+	int n;
+	register sym_p sp;
+
+	i = p = (line_p) 0;
+	curdtyp=0;
+	for (lnp = curpro.lastline; lnp != (line_p) 0; lnp = next) {
+		next = lnp->l_next;
+		switch(lnp->l_optyp) {
+		case OPSYMBOL:
+			global(lnp->l_a.la_sp);
+			break;
+		case OPSVAL:
+			global(lnp->l_a.la_sval.lasv_sp);
+			break;
+		case OPLVAL:
+			global(lnp->l_a.la_lval.lalv_sp);
+			break;
+		case OPLIST:
+			ap = lnp->l_a.la_arg;
+			while (ap != (arg_p) 0 ) {
+				switch(ap->a_typ) {
+				case ARGSYM:
+					global(ap->a_a.a_sp);
+					break;
+				case ARGVAL:
+					global(ap->a_a.a_val.av_sp);
+				}
+				ap = ap->a_next;
+			}
+			break;
+		}
+
+		/*
+		 * references to symbols are processed now.
+		 * for plain instructions nothing else is needed
+		 */
+
+		switch(lnp->l_instr&BMASK) {
+		/*
+		 * count all local occurences for register counts;
+		 * op_lal is omitted and not by accident.
+		 */
+		case op_del:
+		case op_inl:
+		case op_ldl:
+		case op_lil:
+		case op_lol:
+		case op_sdl:
+		case op_sil:
+		case op_stl:
+		case op_zrl:
+			switch(lnp->l_optyp) {
+			case OPNO:
+			case OPNUMLAB:
+			case OPSYMBOL:
+			case OPSVAL:
+			case OPLVAL:
+			case OPLIST:
+				break;
+			case OPOFFSET:
+				incregusage(lnp->l_a.la_offset);
+				break;
+			case OPSHORT:
+				incregusage((offset)lnp->l_a.la_short);
+				break;
+			default:
+				incregusage((offset)(lnp->l_optyp&BMASK)-Z_OPMINI);
+				break;
+			}
+			/* fall through !! */
+		default:
+			assert((lnp->l_instr&BMASK)<=op_last);
+			lnp->l_next = i;
+			i = lnp;
+			continue;
+		case ps_sym:
+			sp = lnp->l_a.la_sp;
+			local(sp);
+			if (curdtyp == DTYPROM && goodrom) {
+				sp->s_rom = newrom();
+				for (n=0;n<rc;n++)
+					sp->s_rom[n] = rombuf[n];
+			}
+			sp->s_frag = curfrag;
+			break;
+		case ps_hol:
+			curdtyp = DTYPHOL;
+			curfrag++;
+			break;
+		case ps_bss:
+			curdtyp = DTYPBSS;
+			curfrag++;
+			break;
+		case ps_con:
+			if (curdtyp != DTYPCON) {
+				curdtyp = DTYPCON;
+				curfrag++;
+			}
+			break;
+		case ps_rom:
+			if (curdtyp != DTYPROM) {
+				curdtyp = DTYPROM;
+				curfrag++;
+			}
+			ap = lnp->l_a.la_arg;
+			rc = 0;
+			while (ap != (arg_p) 0 && rc < MAXROM) {
+				if (ap->a_typ == ARGOFF) {
+					rombuf[rc++] = ap->a_a.a_offset;
+					ap = ap->a_next;
+				} else
+					ap = (arg_p) 0;
+			}
+			goodrom = (rc >= 2);
+			break;
+		case ps_mes:
+			break;
+		case ps_inp:
+		case ps_ina:
+			local(lnp->l_a.la_sp);
+		case ps_exp:
+		case ps_exa:
+		case ps_exc:
+			oldline(lnp);
+			continue;
+		}
+		lnp->l_next = p;
+		p = lnp;
+	}
+	if (prodepth != 0)
+		local(curpro.symbol);
+	instrs = i; pseudos = p; curpro.lastline = (line_p) 0;
+}

+ 65 - 0
util/opt/cleanup.c

@@ -0,0 +1,65 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include <stdio.h>
+#include "param.h"
+#include "types.h"
+#include "assert.h"
+#include "../../h/em_pseu.h"
+#include "../../h/em_spec.h"
+#include "../../h/em_mes.h"
+#include "lookup.h"
+#include "ext.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+
+cleanup() {
+	FILE *infile;
+	register c;
+	register sym_p *spp,sp;
+
+ 	for (spp=symhash;spp< &symhash[NSYMHASH];spp++)
+ 		for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
+ 			if ((sp->s_flags & SYMOUT) == 0)
+ 				outdef(sp);
+	if(!Lflag)
+		return;
+	c=fclose(outfile);
+	assert(c != EOF);
+	outfile = stdout;
+	infile = fopen(template,"r");
+	if (infile == NULL)
+		error("temp file disappeared");
+	outshort(sp_magic);
+	outinst(ps_mes);
+	outint(ms_ext);
+	for (spp=symhash;spp< &symhash[NSYMHASH];spp++)
+		for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
+			if ((sp->s_flags&(SYMDEF|SYMGLOBAL)) == (SYMDEF|SYMGLOBAL))
+				outsym(sp);
+	putc(sp_cend,outfile);
+	while ( (c=getc(infile)) != EOF)
+		putc(c,outfile);
+	c=fclose(infile);
+	assert(c != EOF);
+	c=unlink(template);
+	assert(c == 0);
+}

+ 16 - 0
util/opt/ext.h

@@ -0,0 +1,16 @@
+/* $Header$ */
+
+#ifndef FILE
+#include <stdio.h>
+#endif
+extern	unsigned linecount;
+extern	int	prodepth;
+extern	bool	Lflag;
+extern	bool	nflag;
+extern	byte	em_flag[];
+extern	line_p	instrs,pseudos;
+extern	FILE	*outfile;
+extern	char	template[];
+extern	offset	wordsize;
+extern	offset	pointersize;
+extern	char	*progname;

+ 126 - 0
util/opt/flow.c

@@ -0,0 +1,126 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "param.h"
+#include "types.h"
+#include "../../h/em_flag.h"
+#include "../../h/em_spec.h"
+#include "../../h/em_mnem.h"
+#include "alloc.h"
+#include "line.h"
+#include "proinf.h"
+#include "optim.h"
+#include "ext.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+flow() {
+
+	findreach();	/* determine reachable labels */
+	cleaninstrs();	/* throw away unreachable code */
+}
+
+findreach() {
+	register num_p	*npp,np;
+
+	reach(instrs);
+	for(npp=curpro.numhash;npp< &curpro.numhash[NNUMHASH]; npp++)
+		for(np= *npp; np != (num_p) 0 ; np = np->n_next)
+			if (np->n_flags&NUMDATA) {
+				np->n_repl->n_flags |= NUMREACH;
+				np->n_repl->n_jumps++;
+				if (!(np->n_flags&NUMSCAN)) {
+					np->n_flags |= NUMSCAN;
+					reach(np->n_line->l_next);
+				}
+			}
+}
+
+reach(lnp) register line_p lnp; {
+	register num_p np;
+
+	for (;lnp != (line_p) 0; lnp = lnp->l_next) {
+		if(lnp->l_optyp == OPNUMLAB) {
+			/*
+			 * Branch instruction or label
+			 */
+			np = lnp->l_a.la_np;
+			if ((lnp->l_instr&BMASK) != op_lab)
+				np = np->n_repl;
+			np->n_flags |= NUMREACH;
+			if (!(np->n_flags&NUMSCAN)) {
+				np->n_flags |= NUMSCAN;
+				reach(np->n_line->l_next);
+			}
+			if ((lnp->l_instr&BMASK) == op_lab)
+				return;
+			else
+				np->n_jumps++;
+		}
+		if ((em_flag[(lnp->l_instr&BMASK)-sp_fmnem]&EM_FLO)==FLO_T)
+			return;
+	}
+}
+
+cleaninstrs() {
+	register line_p *lpp,lp,*lastbra;
+	bool reachable,superfluous;
+	int instr;
+
+	lpp = &instrs; lastbra = (line_p *) 0; reachable = TRUE;
+	while ((lp = *lpp) != (line_p) 0) {
+		instr = lp->l_instr&BMASK;
+		if (instr == op_lab) {
+			if ((lp->l_a.la_np->n_flags&NUMREACH) != 0) {
+				reachable = TRUE;
+				if (lastbra != (line_p *) 0
+				    && (*lastbra)->l_next == lp
+				    && (*lastbra)->l_a.la_np->n_repl==lp->l_a.la_np) {
+					oldline(*lastbra);
+					OPTIM(O_BRALAB);
+					lpp = lastbra;
+					*lpp = lp;
+					lp->l_a.la_np->n_jumps--;
+				}
+			}
+			if ( lp->l_a.la_np->n_repl != lp->l_a.la_np ||
+			     ((lp->l_a.la_np->n_flags&NUMDATA)==0 &&
+			      lp->l_a.la_np->n_jumps == 0))
+				superfluous = TRUE;
+			else
+				superfluous = FALSE;
+		} else
+			superfluous = FALSE;
+		if ( (!reachable) || superfluous) {
+			lp = lp->l_next;
+			oldline(*lpp);
+			OPTIM(O_UNREACH);
+			*lpp = lp;
+		} else {
+			if ( instr <= sp_lmnem &&
+			    (em_flag[instr-sp_fmnem]&EM_FLO)==FLO_T) {
+				reachable = FALSE;
+				if ((lp->l_instr&BMASK) == op_bra)
+					lastbra = lpp;
+			}
+			lpp = &lp->l_next;
+		}
+	}
+}

+ 556 - 0
util/opt/getline.c

@@ -0,0 +1,556 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include <stdio.h>
+#include "param.h"
+#include "types.h"
+#include "assert.h"
+#include "line.h"
+#include "lookup.h"
+#include "alloc.h"
+#include "proinf.h"
+#include "../../h/em_spec.h"
+#include "../../h/em_pseu.h"
+#include "../../h/em_flag.h"
+#include "../../h/em_mes.h"
+#include "ext.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+
+static  short   tabval;         /* temp store for shorts */
+static  offset  tabval2;        /* temp store for offsets */
+static  char    string[IDL+1];  /* temp store for names */
+
+/*
+ * The next constants are close to sp_cend for fast switches
+ */
+#define INST    256     /* instruction:         number in tabval */
+#define PSEU    257     /* pseudo:              number in tabval */
+#define ILBX    258     /* label:               number in tabval */
+#define DLBX    259     /* symbol:              name in string[] */
+#define CSTX1   260     /* short constant:      stored in tabval */
+#define CSTX2   261     /* offset:              value in tabval2 */
+#define VALX1   262     /* symbol+short:        in string[] and tabval */
+#define VALX2   263     /* symbol+offset:       in string[] and tabval2 */
+#define ATEOF   264     /* bumped into end of file */
+
+#define readbyte getchar
+
+short readshort() {
+	register int l_byte, h_byte;
+
+	l_byte = readbyte();
+	h_byte = readbyte();
+	if ( h_byte>=128 ) h_byte -= 256 ;
+	return l_byte | (h_byte*256) ;
+}
+
+#ifdef LONGOFF
+offset readoffset() {
+	register long l;
+	register int h_byte;
+
+	l = readbyte();
+	l |= ((unsigned) readbyte())*256 ;
+	l |= readbyte()*256L*256L ;
+	h_byte = readbyte() ;
+	if ( h_byte>=128 ) h_byte -= 256 ;
+	return l | (h_byte*256L*256*256L) ;
+}
+#endif
+
+draininput() {
+
+	/*
+	 * called when MES ERR is encountered.
+	 * Drain input in case it is a pipe.
+	 */
+
+	while (getchar() != EOF)
+		;
+}
+
+short getint() {
+
+	switch(table2()) {
+	default: error("int expected");
+	case CSTX1:
+		return(tabval);
+	}
+}
+
+sym_p getsym(status) int status; {
+
+	switch(table2()) {
+	default:
+		error("symbol expected");
+	case DLBX:
+		return(symlookup(string,status,0));
+	case sp_pnam:
+		return(symlookup(string,status,SYMPRO));
+	}
+}
+
+offset getoff() {
+
+	switch (table2()) {
+	default: error("offset expected");
+	case CSTX1:
+		return((offset) tabval);
+#ifdef LONGOFF
+	case CSTX2:
+		return(tabval2);
+#endif
+	}
+}
+
+make_string(n) int n; {
+	register char *s;
+	extern char *sprintf();
+
+	s=sprintf(string,".%u",n);
+	assert(s == string);
+}
+
+inident() {
+	register n;
+	register char *p = string;
+	register c;
+
+	n = getint();
+	while (n--) {
+		c = readbyte();
+		if (p<&string[IDL])
+			*p++ = c;
+	}
+	*p++ = 0;
+}
+
+int table3(n) int n; {
+
+	switch (n) {
+	case sp_ilb1:   tabval = readbyte(); return(ILBX);
+	case sp_ilb2:   tabval = readshort(); return(ILBX);
+	case sp_dlb1:   make_string(readbyte()); return(DLBX);
+	case sp_dlb2:   make_string(readshort()); return(DLBX);
+	case sp_dnam:   inident(); return(DLBX);
+	case sp_pnam:   inident(); return(n);
+	case sp_cst2:   tabval = readshort(); return(CSTX1);
+#ifdef LONGOFF
+	case sp_cst4:   tabval2 = readoffset(); return(CSTX2);
+#endif
+	case sp_doff:   if (table2()!=DLBX) error("symbol expected");
+			switch(table2()) {
+			default:        error("offset expected");
+			case CSTX1:             return(VALX1);
+#ifdef LONGOFF
+			case CSTX2:             return(VALX2);
+#endif
+			}
+	default:        return(n);
+	}
+}
+
+int table1() {
+	register n;
+
+	n = readbyte();
+	if (n == EOF)
+		return(ATEOF);
+	if ((n <= sp_lmnem) && (n >= sp_fmnem)) {
+		tabval = n;
+		return(INST);
+	}
+	if ((n <= sp_lpseu) && (n >= sp_fpseu)) {
+		tabval = n;
+		return(PSEU);
+	}
+	if ((n < sp_filb0 + sp_nilb0) && (n >= sp_filb0)) {
+		tabval = n - sp_filb0;
+		return(ILBX);
+	}
+	return(table3(n));
+}
+
+int table2() {
+	register n;
+
+	n = readbyte();
+	if ((n < sp_fcst0 + sp_ncst0) && (n >= sp_fcst0)) {
+		tabval = n - sp_zcst0;
+		return(CSTX1);
+	}
+	return(table3(n));
+}
+
+getlines() {
+	register line_p lnp;
+	register instr;
+
+    for(;;) {
+	linecount++;
+	switch(table1()) {
+	default:
+		error("unknown instruction byte");
+		/* NOTREACHED */
+
+	case ATEOF:
+		if (prodepth!=0)
+			error("procedure unterminated at eof");
+		process();
+		return;
+	case INST:
+		tstinpro();
+		instr = tabval;
+		break;
+	case DLBX:
+		lnp = newline(OPSYMBOL);
+		lnp->l_instr = ps_sym;
+		lnp->l_a.la_sp= symlookup(string,DEFINING,0);
+		lnp->l_next = curpro.lastline;
+		curpro.lastline = lnp;
+		continue;
+	case ILBX:
+		tstinpro();
+		lnp = newline(OPNUMLAB);
+		lnp->l_instr = op_lab;
+		lnp->l_a.la_np = numlookup((unsigned) tabval);
+		if (lnp->l_a.la_np->n_line != (line_p) 0)
+			error("label %u multiple defined",(unsigned) tabval);
+		lnp->l_a.la_np->n_line = lnp;
+		lnp->l_next = curpro.lastline;
+		curpro.lastline = lnp;
+		continue;
+	case PSEU:
+		if(inpseudo(tabval))
+			return;
+		continue;
+	}
+
+	/*
+	 * Now we have an instruction number in instr
+	 * There might be an operand, look for it
+	 */
+
+	if ((em_flag[instr-sp_fmnem]&EM_PAR)==PAR_NO) {
+		lnp = newline(OPNO);
+	} else switch(table2()) {
+	default:
+		error("unknown offset byte");
+	case sp_cend:
+		lnp = newline(OPNO);
+		break;
+	case CSTX1:
+		if ((em_flag[instr-sp_fmnem]&EM_PAR)!= PAR_B) {
+			if (CANMINI(tabval))
+				lnp = newline(tabval+Z_OPMINI);
+			else {
+				lnp = newline(OPSHORT);
+				lnp->l_a.la_short = tabval;
+			}
+		} else {
+			lnp = newline(OPNUMLAB);
+			lnp->l_a.la_np = numlookup((unsigned) tabval);
+		}
+		break;
+#ifdef LONGOFF
+	case CSTX2:
+		lnp = newline(OPOFFSET);
+		lnp->l_a.la_offset = tabval2;
+		break;
+#endif
+	case ILBX:
+		tstinpro();
+		lnp = newline(OPNUMLAB);
+		lnp->l_a.la_np = numlookup((unsigned) tabval);
+		break;
+	case DLBX:
+		lnp = newline(OPSYMBOL);
+		lnp->l_a.la_sp = symlookup(string,OCCURRING,0);
+		break;
+	case sp_pnam:
+		lnp = newline(OPSYMBOL);
+		lnp->l_a.la_sp = symlookup(string,OCCURRING,SYMPRO);
+		break;
+	case VALX1:
+		lnp = newline(OPSVAL);
+		lnp->l_a.la_sval.lasv_sp = symlookup(string,OCCURRING,0);
+		lnp->l_a.la_sval.lasv_short = tabval;
+		break;
+#ifdef LONGOFF
+	case VALX2:
+		lnp = newline(OPLVAL);
+		lnp->l_a.la_lval.lalv_sp = symlookup(string,OCCURRING,0);
+		lnp->l_a.la_lval.lalv_offset = tabval2;
+		break;
+#endif
+	}
+	lnp->l_instr = instr;
+	lnp->l_next = curpro.lastline;
+	curpro.lastline = lnp;
+    }
+}
+
+argstring(length,abp) offset length; register argb_p abp; {
+
+	while (length--) {
+		if (abp->ab_index == NARGBYTES)
+			abp = abp->ab_next = newargb();
+		abp->ab_contents[abp->ab_index++] = readbyte();
+	}
+}
+
+line_p  arglist(n) int n; {
+	line_p  lnp;
+	register arg_p ap,*app;
+	bool moretocome;
+	offset length;
+
+
+	/*
+	 * creates an arglist with n elements
+	 * if n == 0 the arglist is variable and terminated by sp_cend
+	 */
+
+	lnp = newline(OPLIST);
+	app = &lnp->l_a.la_arg;
+	moretocome = TRUE;
+	do {
+		switch(table2()) {
+		default:
+			error("unknown byte in arglist");
+		case CSTX1:
+			tabval2 = (offset) tabval;
+		case CSTX2:
+			*app = ap = newarg(ARGOFF);
+			ap->a_a.a_offset = tabval2;
+			app = &ap->a_next;
+			break;
+		case ILBX:
+			tstinpro();
+			*app = ap = newarg(ARGNUM);
+			ap->a_a.a_np = numlookup((unsigned) tabval);
+			ap->a_a.a_np->n_flags |= NUMDATA;
+			app = &ap->a_next;
+			break;
+		case DLBX:
+			*app = ap = newarg(ARGSYM);
+			ap->a_a.a_sp = symlookup(string,OCCURRING,0);
+			app = &ap->a_next;
+			break;
+		case sp_pnam:
+			*app = ap = newarg(ARGSYM);
+			ap->a_a.a_sp = symlookup(string,OCCURRING,SYMPRO);
+			app = &ap->a_next;
+			break;
+		case VALX1:
+			tabval2 = (offset) tabval;
+		case VALX2:
+			*app = ap = newarg(ARGVAL);
+			ap->a_a.a_val.av_sp = symlookup(string,OCCURRING,0);
+			ap->a_a.a_val.av_offset = tabval2;
+			app = &ap->a_next;
+			break;
+		case sp_scon:
+			*app = ap = newarg(ARGSTR);
+			length = getoff();
+			argstring(length,&ap->a_a.a_string);
+			app = &ap->a_next;
+			break;
+		case sp_icon:
+			*app = ap = newarg(ARGICN);
+			goto casecon;
+		case sp_ucon:
+			*app = ap = newarg(ARGUCN);
+			goto casecon;
+		case sp_fcon:
+			*app = ap = newarg(ARGFCN);
+		casecon:
+			length = getint();
+			ap->a_a.a_con.ac_length = (short) length;
+			argstring(getoff(),&ap->a_a.a_con.ac_con);
+			app = &ap->a_next;
+			break;
+		case sp_cend:
+			moretocome = FALSE;
+		}
+		if (n && (--n) == 0)
+			moretocome = FALSE;
+	} while (moretocome);
+	return(lnp);
+}
+
+offset aoff(ap,n) register arg_p ap; {
+
+	while (n>0) {
+		if (ap != (arg_p) 0)
+			ap = ap->a_next;
+		n--;
+	}
+	if (ap == (arg_p) 0)
+		error("too few parameters");
+	if (ap->a_typ != ARGOFF)
+		error("offset expected");
+	return(ap->a_a.a_offset);
+}
+
+int inpseudo(n) short n; {
+	register line_p lnp,head,tail;
+	short           n1,n2;
+	proinf savearea;
+#ifdef PSEUBETWEEN
+	static int pcount=0;
+
+	if (pcount++ >= PSEUBETWEEN && prodepth==0) {
+		process();
+		pcount=0;
+	}
+#endif
+
+	switch(n) {
+	default:
+		error("unknown pseudo");
+	case ps_bss:
+	case ps_hol:
+		lnp = arglist(3);
+		break;
+	case ps_rom:
+	case ps_con:
+		lnp = arglist(0);
+		break;
+	case ps_ina:
+	case ps_inp:
+	case ps_exa:
+	case ps_exp:
+		lnp = newline(OPSYMBOL);
+		lnp->l_a.la_sp = getsym(NOTHING);
+		break;
+	case ps_exc:
+		n1 = getint(); n2 = getint();
+		if (n1 != 0 && n2 != 0) {
+			tail = curpro.lastline;
+			while (--n2) tail = tail->l_next;
+			head = tail;
+			while (n1--) head = head->l_next;
+			lnp = tail->l_next;
+			tail->l_next = head->l_next;
+			head->l_next = curpro.lastline;
+			curpro.lastline = lnp;
+		}
+		lnp = newline(OPNO);
+		break;
+	case ps_mes:
+		lnp = arglist(0);
+		switch((int) aoff(lnp->l_a.la_arg,0)) {
+		case ms_err:
+			draininput(); exit(-1);
+		case ms_opt:
+			nflag = TRUE; break;
+		case ms_emx:
+			wordsize = aoff(lnp->l_a.la_arg,1);
+			pointersize = aoff(lnp->l_a.la_arg,2);
+#ifndef LONGOFF
+			if (wordsize>2)
+				error("This optimizer cannot handle wordsize>2");
+#endif
+			break;
+		case ms_gto:
+			curpro.gtoproc=1;
+			/* Treat as empty mes ms_reg */
+		case ms_reg:
+			tstinpro();
+			regvar(lnp->l_a.la_arg->a_next);
+			oldline(lnp);
+			lnp=newline(OPNO);
+			n=ps_exc;	/* kludge to force out this line */
+			break;
+		}
+		break;
+	case ps_pro:
+		if (prodepth>0)
+			savearea = curpro;
+		else
+			process();
+		curpro.symbol = getsym(DEFINING);
+		switch(table2()) {
+		case sp_cend:
+			curpro.localbytes = (offset) -1;
+			break;
+		case CSTX1:
+			tabval2 = (offset) tabval;
+		case CSTX2:
+			curpro.localbytes = tabval2;
+			break;
+		default:
+			error("bad second arg of PRO");
+		}
+		prodepth++;
+		curpro.gtoproc=0;
+		if (prodepth>1) {
+			register i;
+
+			curpro.lastline = (line_p) 0;
+			curpro.freg = (reg_p) 0;
+			for(i=0;i<NNUMHASH;i++)
+				curpro.numhash[i] = (num_p) 0;
+			getlines();
+			curpro = savearea;
+			prodepth--;
+		}
+		return(0);
+	case ps_end:
+		if (prodepth==0)
+			error("END misplaced");
+		switch(table2()) {
+		case sp_cend:
+			if (curpro.localbytes == (offset) -1)
+				error("bytes for locals still unknown");
+			break;
+		case CSTX1:
+			tabval2 = (offset) tabval;
+		case CSTX2:
+			if (curpro.localbytes != (offset) -1 && curpro.localbytes != tabval2)
+				error("inconsistency in number of bytes for locals");
+			curpro.localbytes = tabval2;
+			break;
+		}
+		process();
+		curpro.symbol = (sym_p) 0;
+		if (prodepth==1) {
+			prodepth=0;
+#ifdef PSEUBETWEEN
+			pcount=0;
+#endif
+			return(0);
+		} else
+			return(1);
+	}
+	lnp->l_instr = n;
+	lnp->l_next = curpro.lastline;
+	curpro.lastline = lnp;
+	return(0);
+}
+
+tstinpro() {
+
+	if (prodepth==0)
+		error("This is not allowed outside a procedure");
+}

+ 88 - 0
util/opt/line.h

@@ -0,0 +1,88 @@
+/* $Header$ */
+
+#define NARGBYTES	14
+struct argbytes {
+	argb_p	ab_next;
+	short	ab_index;
+	char	ab_contents[NARGBYTES];
+};
+
+typedef struct {
+	sym_p	av_sp;
+	offset	av_offset;
+} s_a_val;
+
+typedef struct {
+	short	ac_length;
+	argb_t	ac_con;
+} s_a_con;
+
+typedef union {
+	offset	a_offset;
+	num_p	a_np;
+	sym_p	a_sp;
+	s_a_val	a_val;
+	argb_t	a_string;
+	s_a_con	a_con;
+} un_a_a;
+
+struct arg {
+	arg_p	a_next;
+	short	a_typ;
+	un_a_a	a_a;
+};
+
+/* possible values for .a_typ
+ */
+
+#define ARGOFF	0
+#define ARGNUM	1
+#define ARGSYM	2
+#define ARGVAL	3
+#define ARGSTR	4
+#define ARGICN	5
+#define ARGUCN	6
+#define ARGFCN	7
+
+typedef struct {
+	sym_p	lasv_sp;
+	short	lasv_short;
+} s_la_sval;
+
+typedef struct {
+	sym_p	lalv_sp;
+	offset	lalv_offset;
+} s_la_lval;
+
+typedef union {
+	short	la_short;
+	offset	la_offset;
+	num_p	la_np;
+	sym_p	la_sp;
+	s_la_sval la_sval;
+	s_la_lval la_lval;
+	arg_p	la_arg;
+} un_l_a;
+
+struct line {
+	line_p		l_next;		/* maintains linked list */
+	byte		l_instr;	/* instruction number */
+	byte		l_optyp;	/* specifies what follows */
+	un_l_a		l_a;
+};
+
+/* Possible values for .l_optyp */
+
+#define OPNO		0	/* no operand */
+#define OPSHORT		1	/* 16 bit number */
+#define OPOFFSET	2	/* 16 or 32 bit number */
+#define OPNUMLAB	3	/* local label for branches */
+#define OPSYMBOL	4	/* global label or procedurename */
+#define OPSVAL		5	/* symbol + 16 bit constant */
+#define OPLVAL		6	/* symbol + 16 or 32 bit constant */
+#define OPLIST		7	/* operand list for some pseudos */
+#define OPMINI		8	/* start of minis */
+
+#define Z_OPMINI	(OPMINI+100)	/* tunable */
+
+#define CANMINI(x) ((x)>=OPMINI-Z_OPMINI && (x)<256-Z_OPMINI)

+ 94 - 0
util/opt/lookup.c

@@ -0,0 +1,94 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include "param.h"
+#include "types.h"
+#include "lookup.h"
+#include "alloc.h"
+#include "proinf.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+unsigned hash(string) char *string; {
+	register char *p;
+	register unsigned i,sum;
+
+	for (sum=i=0,p=string;*p;i += 3)
+		sum ^= (*p++)<<(i&07);
+	return(sum);
+}
+
+sym_p symlookup(name,status,flags) char *name; int status,flags; {
+	register sym_p *spp,sp;
+ 	register i;
+	static short genfrag = 32767;
+
+	spp = &symhash[hash(name)%NSYMHASH];
+	while (*spp != (sym_p) 0)
+		if (strncmp((*spp)->s_name,name,IDL)==0) {
+			sp = *spp;
+			if ((sp->s_flags^flags)&SYMPRO)
+				error("%s is both proc and datalabel",name);
+			if (status == DEFINING) {
+				if (sp->s_flags&SYMDEF)
+					error("redefined symbol %s",name);
+				sp->s_flags |= SYMDEF;
+			}
+			return(sp);
+		} else
+			spp = &(*spp)->s_next;
+
+	/*
+	 * symbol not found, enter in table
+	 */
+
+ 	i = strlen(name) + 1;
+ 	if (i & 1)
+ 		i++;
+ 	if (i > IDL)
+ 		i = IDL;
+ 	*spp = sp = newsym(i);
+ 	strncpy(sp->s_name,name,i);
+	sp->s_flags = flags;
+	if (status == DEFINING)
+		sp->s_flags |= SYMDEF;
+	sp->s_frag = genfrag--;
+	return(sp);
+}
+
+num_p numlookup(number) unsigned number; {
+	register num_p *npp, np;
+
+	npp = &curpro.numhash[number%NNUMHASH];
+	while (*npp != (num_p) 0)
+		if ((*npp)->n_number == number)
+			return(*npp);
+		else
+			npp = &(*npp)->n_next;
+
+	/*
+	 * local label not found, enter in tabel
+	 */
+
+	*npp = np = newnum();
+	np->n_number = number;
+	np->n_repl = np;
+	return(np);
+}

+ 25 - 0
util/opt/lookup.h

@@ -0,0 +1,25 @@
+/* $Header$ */
+
+#define IDL	100
+
+struct sym {
+	sym_p	s_next;
+	offset	*s_rom;
+	short	s_flags;
+	short	s_frag;
+	offset	s_value;
+	char	s_name[2];	/* to be extended up to IDL */
+};
+
+/* contents of .s_flags */
+#define SYMPRO		000001
+#define SYMGLOBAL	000002
+#define SYMKNOWN	000004
+#define SYMOUT		000010
+#define SYMDEF		000020
+
+#define NSYMHASH	127
+extern sym_p symhash[NSYMHASH],symlookup();
+#define OCCURRING	0
+#define DEFINING	1
+#define NOTHING		2

+ 77 - 0
util/opt/main.c

@@ -0,0 +1,77 @@
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include <stdio.h>
+#include "param.h"
+#include "types.h"
+#include "alloc.h"
+#include "../../h/em_spec.h"
+#include "ext.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+/*
+ * Main program for EM optimizer
+ */
+
+main(argc,argv) int argc; char *argv[]; {
+	short somespace[STACKROOM];
+
+	progname = argv[0];
+	while (argc-->1 && **++argv == '-')
+		flags(*argv);
+	if (argc>1) {
+		fprintf(stderr,"Usage: %s [-Ln] [name]\n",progname);
+		exit(-1);
+	}
+	if (argc)
+		if (freopen(*argv,"r",stdin) == NULL)
+			error("Cannot open %s",*argv);
+	fileinit();
+	coreinit(somespace,somespace+STACKROOM);
+	getlines();
+	cleanup();
+	return(0);
+}
+
+flags(s) register char *s; {
+
+	for (s++;*s;s++)
+		switch(*s) {
+		case 'L':	Lflag = TRUE; break;
+		case 'n':	nflag = TRUE; break;
+		}
+}
+
+fileinit() {
+	char *mktemp();
+	short readshort();
+
+	if (readshort() != (short) sp_magic)
+		error("wrong input file");
+	if (Lflag) {
+		outfile = fopen(mktemp(template),"w");
+		if (outfile == NULL)
+			error("can't create %s",template);
+	} else {
+		outfile = stdout;
+		outshort(sp_magic);
+	}
+}

+ 15 - 0
util/opt/makedepend

@@ -0,0 +1,15 @@
+: '$Header$'
+for extension in c y
+do
+    for file in *.$extension
+    do ofile=`basename $file .$extension`.o
+    grep '^# *include.*"' $file|sed "s/.*\"\(.*\)\".*/$ofile:	\1/"
+    done
+done | sort -u >depend
+ed - Makefile <<'!'
+/AUTOAUTOAUTO/+,$d
+$r depend
+w
+q
+!
+rm -f depend

+ 366 - 0
util/opt/mktab.y

@@ -0,0 +1,366 @@
+%{
+#ifndef NORCSID
+static char rcsid[] = "$Header$";
+#endif
+
+#include <stdio.h>
+#include "param.h"
+#include "types.h"
+#include "pattern.h"
+#include "../../h/em_spec.h"
+#include "../../h/em_mnem.h"
+#include "optim.h"
+
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ * Author: Hans van Staveren
+ */
+
+#define MAXNODES 1000
+expr_t	nodes[MAXNODES];
+expr_p	lastnode = nodes+1;
+int	curind,prevind;
+int	patlen,maxpatlen,rpllen;
+int	lino = 1;
+int	patno=1;
+#define MAX	100
+int patmnem[MAX],rplmnem[MAX],rplexpr[MAX];
+byte	nparam[N_EX_OPS];
+bool	nonumlab[N_EX_OPS];
+bool	onlyconst[N_EX_OPS];
+int	nerrors=0;
+%}
+
+%union {
+	int	y_int;
+}
+
+%left OR2
+%left AND2
+%left OR1
+%left XOR1
+%left AND1
+%left CMPEQ,CMPNE
+%left CMPLT,CMPLE,CMPGT,CMPGE
+%left RSHIFT,LSHIFT
+%left ARPLUS,ARMINUS
+%left ARTIMES,ARDIVIDE,ARMOD
+%nonassoc NOT,COMP,UMINUS
+%nonassoc '$'
+
+%token SFIT,UFIT,NOTREG,PSIZE,WSIZE,DEFINED,SAMESIGN,ROM,ROTATE
+%token <y_int> MNEM
+%token <y_int> NUMBER
+%type <y_int> expr,argno,optexpr
+
+%start patternlist
+
+%%
+patternlist
+	:	/* empty */
+	|	patternlist '\n'
+	|	patternlist pattern
+	;
+pattern	:
+		mnemlist optexpr ':' replacement '\n'
+			{ register i;
+			  outbyte(0); outshort(prevind); prevind=curind-3;
+			  out(patlen);
+			  for (i=0;i<patlen;i++) outbyte(patmnem[i]);
+			  out($2);
+			  out(rpllen);
+			  for (i=0;i<rpllen;i++) {
+				outbyte(rplmnem[i]);
+				out(rplexpr[i]);
+			  }
+#ifdef DIAGOPT
+			  outshort(patno);
+#endif
+			  patno++;
+			  printf("\n");
+			  if (patlen>maxpatlen) maxpatlen=patlen;
+			}
+	|	error '\n'
+			{ yyerrok; }
+	;
+replacement
+	:	expr	/* special optimization */
+			{
+#ifdef ALLOWSPECIAL
+			  rpllen=1; rplmnem[0]=0; rplexpr[0]=$1;
+#else
+			  yyerror("No specials allowed");
+#endif
+			}
+	|	repllist
+	;
+repllist:	/* empty */
+			{ rpllen=0; }
+	|	repllist repl
+	;
+repl	:	MNEM	optexpr
+			{ rplmnem[rpllen] = $1; rplexpr[rpllen++] = $2; }
+	;
+mnemlist:	MNEM
+			{ patlen=0; patmnem[patlen++] = $1; }
+	|	mnemlist MNEM
+			{ patmnem[patlen++] = $2; }
+	;
+optexpr	:	/* empty */
+			{ $$ = 0; }
+	|	expr
+	;
+expr	
+	:	'$' argno
+			{ $$ = lookup(0,EX_ARG,$2,0); }
+	|	NUMBER
+			{ $$ = lookup(0,EX_CON,(int)(short)$1,0); }
+	|	PSIZE
+			{ $$ = lookup(0,EX_POINTERSIZE,0,0); }
+	|	WSIZE
+			{ $$ = lookup(0,EX_WORDSIZE,0,0); }
+	|	DEFINED '(' expr ')'
+			{ $$ = lookup(0,EX_DEFINED,$3,0); }
+	|	SAMESIGN '(' expr ',' expr ')'
+			{ $$ = lookup(1,EX_SAMESIGN,$3,$5); }
+	|	SFIT '(' expr ',' expr ')'
+			{ $$ = lookup(0,EX_SFIT,$3,$5); }
+	|	UFIT '(' expr ',' expr ')'
+			{ $$ = lookup(0,EX_UFIT,$3,$5); }
+	|	ROTATE '(' expr ',' expr ')'
+			{ $$ = lookup(0,EX_ROTATE,$3,$5); }
+	|	NOTREG '(' expr ')'
+			{ $$ = lookup(0,EX_NOTREG,$3,0); }
+	|	ROM '(' argno ',' expr ')'
+			{ $$ = lookup(0,EX_ROM,$3,$5); }
+	|	'(' expr ')'
+			{ $$ = $2; }
+	|	expr CMPEQ expr
+			{ $$ = lookup(1,EX_CMPEQ,$1,$3); }
+	|	expr CMPNE expr
+			{ $$ = lookup(1,EX_CMPNE,$1,$3); }
+	|	expr CMPGT expr
+			{ $$ = lookup(0,EX_CMPGT,$1,$3); }
+	|	expr CMPGE expr
+			{ $$ = lookup(0,EX_CMPGE,$1,$3); }
+	|	expr CMPLT expr
+			{ $$ = lookup(0,EX_CMPLT,$1,$3); }
+	|	expr CMPLE expr
+			{ $$ = lookup(0,EX_CMPLE,$1,$3); }
+	|	expr OR2 expr
+			{ $$ = lookup(0,EX_OR2,$1,$3); }
+	|	expr AND2 expr
+			{ $$ = lookup(0,EX_AND2,$1,$3); }
+	|	expr OR1 expr
+			{ $$ = lookup(1,EX_OR1,$1,$3); }
+	|	expr XOR1 expr
+			{ $$ = lookup(1,EX_XOR1,$1,$3); }
+	|	expr AND1 expr
+			{ $$ = lookup(1,EX_AND1,$1,$3); }
+	|	expr ARPLUS expr
+			{ $$ = lookup(1,EX_PLUS,$1,$3); }
+	|	expr ARMINUS expr
+			{ $$ = lookup(0,EX_MINUS,$1,$3); }
+	|	expr ARTIMES expr
+			{ $$ = lookup(1,EX_TIMES,$1,$3); }
+	|	expr ARDIVIDE expr
+			{ $$ = lookup(0,EX_DIVIDE,$1,$3); }
+	|	expr ARMOD expr
+			{ $$ = lookup(0,EX_MOD,$1,$3); }
+	|	expr LSHIFT expr
+			{ $$ = lookup(0,EX_LSHIFT,$1,$3); }
+	|	expr RSHIFT expr
+			{ $$ = lookup(0,EX_RSHIFT,$1,$3); }
+	|	ARPLUS expr %prec UMINUS
+			{ $$ = $2; }
+	|	ARMINUS expr %prec UMINUS
+			{ $$ = lookup(0,EX_UMINUS,$2,0); }
+	|	NOT expr
+			{ $$ = lookup(0,EX_NOT,$2,0); }
+	|	COMP expr
+			{ $$ = lookup(0,EX_COMP,$2,0); }
+	;
+argno	:	NUMBER
+			{ if ($1<1 || $1>patlen) {
+				YYERROR;
+			  }
+			  $$ = (int) $1;
+			}
+	;
+
+%%
+
+extern char em_mnem[][4];
+
+#define HASHSIZE	(2*(sp_lmnem-sp_fmnem))
+
+struct hashmnem {
+	char h_name[3];
+	byte h_value;
+} hashmnem[HASHSIZE];
+
+inithash() {
+	register i;
+
+	enter("lab",op_lab);
+	enter("LLP",op_LLP);
+	enter("LEP",op_LEP);
+	enter("SLP",op_SLP);
+	enter("SEP",op_SEP);
+	for(i=0;i<=sp_lmnem-sp_fmnem;i++)
+		enter(em_mnem[i],i+sp_fmnem);
+}
+
+unsigned hashname(name) register char *name; {
+	register unsigned h;
+
+	h = (*name++)&BMASK;
+	h = (h<<4)^((*name++)&BMASK);
+	h = (h<<4)^((*name++)&BMASK);
+	return(h);
+}
+
+enter(name,value) char *name; {
+	register unsigned h;
+
+	h=hashname(name)%HASHSIZE;
+	while (hashmnem[h].h_name[0] != 0)
+		h = (h+1)%HASHSIZE;
+	strncpy(hashmnem[h].h_name,name,3);
+	hashmnem[h].h_value = value;
+}
+
+int mlookup(name) char *name; {
+	register unsigned h;
+
+	h = hashname(name)%HASHSIZE;
+	while (strncmp(hashmnem[h].h_name,name,3) != 0 &&
+	       hashmnem[h].h_name[0] != 0)
+		h = (h+1)%HASHSIZE;
+	return(hashmnem[h].h_value&BMASK);	/* 0 if not found */
+}
+
+main() {
+
+	inithash();
+	initio();
+	yyparse();
+	if (nerrors==0)
+		printnodes();
+	return nerrors;
+}
+
+yyerror(s) char *s; {
+
+	fprintf(stderr,"line %d: %s\n",lino,s);
+	nerrors++;
+}
+
+lookup(comm,operator,lnode,rnode) {
+	register expr_p p;
+
+	for (p=nodes+1;p<lastnode;p++) {
+		if (p->ex_operator != operator)
+			continue;
+		if (!(p->ex_lnode == lnode && p->ex_rnode == rnode ||
+		    comm && p->ex_lnode == rnode && p->ex_rnode == lnode))
+			continue;
+		return(p-nodes);
+	}
+	if (lastnode >= &nodes[MAXNODES])
+		yyerror("node table overflow");
+	lastnode++;
+	p->ex_operator = operator;
+	p->ex_lnode = lnode;
+	p->ex_rnode = rnode;
+	return(p-nodes);
+}
+
+printnodes() {
+	register expr_p p;
+
+	printf("};\n\nshort lastind = %d;\n\nexpr_t enodes[] = {\n",prevind);
+	for (p=nodes;p<lastnode;p++)
+		printf("/* %3d */\t%3d,%6u,%6u,\n",
+			p-nodes,p->ex_operator,p->ex_lnode,p->ex_rnode);
+	printf("};\n\niarg_t iargs[%d];\n",maxpatlen);
+}
+
+initio() {
+	register i;
+
+	printf("#include \"param.h\"\n#include \"types.h\"\n");
+	printf("#include \"pattern.h\"\n\n");
+	for(i=0;i<N_EX_OPS;i++) {
+		nparam[i]=2;
+		nonumlab[i]=TRUE;
+		onlyconst[i]=TRUE;
+	}
+	nparam[EX_POINTERSIZE] = 0;
+	nparam[EX_WORDSIZE] = 0;
+	nparam[EX_CON] = 0;
+	nparam[EX_ROM] = 0;
+	nparam[EX_ARG] = 0;
+	nparam[EX_DEFINED] = 0;
+	nparam[EX_OR2] = 1;
+	nparam[EX_AND2] = 1;
+	nparam[EX_UMINUS] = 1;
+	nparam[EX_NOT] = 1;
+	nparam[EX_COMP] = 1;
+	nparam[EX_NOTREG] = 1;
+	nonumlab[EX_CMPEQ] = FALSE;
+	nonumlab[EX_CMPNE] = FALSE;
+	onlyconst[EX_CMPEQ] = FALSE;
+	onlyconst[EX_CMPNE] = FALSE;
+	onlyconst[EX_CMPLE] = FALSE;
+	onlyconst[EX_CMPLT] = FALSE;
+	onlyconst[EX_CMPGE] = FALSE;
+	onlyconst[EX_CMPGT] = FALSE;
+	onlyconst[EX_PLUS] = FALSE;
+	onlyconst[EX_MINUS] = FALSE;
+	printf("byte nparam[] = {");
+	for (i=0;i<N_EX_OPS;i++) printf("%d,",nparam[i]);
+	printf("};\nbool nonumlab[] = {");
+	for (i=0;i<N_EX_OPS;i++) printf("%d,",nonumlab[i]);
+	printf("};\nbool onlyconst[] = {");
+	for (i=0;i<N_EX_OPS;i++) printf("%d,",onlyconst[i]);
+	printf("};\n\nbyte pattern[] = { 0\n");
+	curind = 1;
+}
+
+outbyte(b) {
+
+	printf(",%3d",b);
+	curind++;
+}
+
+outshort(s) {
+
+	outbyte(s&0377);
+	outbyte((s>>8)&0377);
+}
+
+out(w) {
+
+	if (w<255) {
+		outbyte(w);
+	} else {
+		outbyte(255);
+		outshort(w);
+	}
+}
+
+#include "scan.c"

+ 12 - 0
util/opt/optim.h

@@ -0,0 +1,12 @@
+/* $Header$ */
+
+/* #define DIAGOPT /* if defined diagnostics are produced */
+#ifdef DIAGOPT
+#define OPTIM(x) optim(x)
+#define O_UNREACH 1001
+#define O_BRALAB  1002
+#define O_LINLNI  1003
+#define O_LINGONE 1004
+#else
+#define OPTIM(x)	/* NOTHING */
+#endif

+ 15 - 0
util/opt/param.h

@@ -0,0 +1,15 @@
+/* $Header$ */
+
+#define LONGOFF		/* if defined long offsets are used */
+
+#define TRUE	1
+#define FALSE	0
+
+#define MAXROM	3
+
+#define op_lab	(sp_lmnem+1)
+#define op_last	op_lab
+#define ps_sym	(sp_lpseu+1)
+#define ps_last	ps_sym
+
+#define BMASK	0377

+ 126 - 0
util/opt/pattern.h

@@ -0,0 +1,126 @@
+/* $Header$ */
+
+/*
+ * pattern contains the optimization patterns in an apparently
+ * unordered fashion. All patterns follow each other unaligned.
+ * Each pattern looks as follows:
+ *   Byte 0:	high byte of hash value associated with this pattern.
+ *   Byte 1-2:	index of next pattern with same low byte of hash value.
+ *   Byte 3- :	pattern and replacement.
+ *                First comes the pattern length
+ *                then the pattern opcodes,
+ *		  then a boolean expression,
+ *		  then the one-byte replacement length
+ *		  then the intermixed pattern opcodes and operands or
+ *		  0 followed by the one-byte special optimization expression.
+ *   If the DIAGOPT option is set, the optimization is followed
+ *   by the line number in the tables.
+ */
+
+/* #define ALLOWSPECIAL /* Special optimizations allowed */
+
+#define PO_HASH		0
+#define PO_NEXT		1
+#define PO_MATCH	3
+
+struct exprnode {
+	short ex_operator;
+	short ex_lnode;
+	short ex_rnode;
+};
+typedef struct exprnode expr_t;
+typedef struct exprnode *expr_p;
+
+/*
+ * contents of .ex_operator
+ */
+
+#define EX_CON		0
+#define EX_ARG		1
+#define EX_CMPEQ	2
+#define EX_CMPNE	3
+#define EX_CMPGT	4
+#define EX_CMPGE	5
+#define EX_CMPLT	6
+#define EX_CMPLE	7
+#define EX_OR2		8
+#define EX_AND2		9
+#define EX_OR1		10
+#define EX_XOR1		11
+#define EX_AND1		12
+#define EX_PLUS		13
+#define EX_MINUS	14
+#define EX_TIMES	15
+#define EX_DIVIDE	16
+#define EX_MOD		17
+#define EX_LSHIFT	18
+#define EX_RSHIFT	19
+#define EX_UMINUS	20
+#define EX_NOT		21
+#define EX_COMP		22
+#define EX_ROM		23
+#define EX_NOTREG	24
+#define EX_POINTERSIZE	25
+#define EX_WORDSIZE	26
+#define EX_DEFINED	27
+#define EX_SAMESIGN	28
+#define EX_SFIT		29
+#define EX_UFIT		30
+#define EX_ROTATE	31
+#define N_EX_OPS	32	/* must be one higher then previous */
+
+
+/*
+ * Definition of special opcodes used in patterns
+ */
+
+#define op_pfirst op_LLP
+#define op_LLP	(op_last+1)
+#define op_LEP	(op_last+2)
+#define op_SLP	(op_last+3)
+#define op_SEP	(op_last+4)
+#define op_plast op_SEP
+
+/*
+ * Definition of the structure in which instruction operands
+ * are kept during pattern matching.
+ */
+
+typedef struct eval eval_t;
+typedef struct eval *eval_p;
+
+struct eval {
+	short	e_typ;
+	union {
+		offset	e_con;
+		num_p	e_np;
+	} e_v;
+};
+
+/*
+ * contents of .e_typ
+ */
+#define EV_UNDEF	0
+#define EV_CONST	1
+#define EV_NUMLAB	2
+#define EV_FRAG		3	/* and all higher numbers */
+
+typedef struct iarg iarg_t;
+typedef struct iarg *iarg_p;
+
+struct iarg {
+	eval_t	ia_ev;
+	sym_p	ia_sp;
+};
+
+/*
+ * The next extern declarations refer to data generated by mktab
+ */
+
+extern byte pattern[];
+extern short  lastind;
+extern iarg_t iargs[];
+extern byte nparam[];
+extern bool nonumlab[];
+extern bool onlyconst[];
+extern expr_t enodes[];

Certains fichiers n'ont pas été affichés car il y a eu trop de fichiers modifiés dans ce diff